mapmaker/mapmaker.bas at main · 8BitVino/mapmaker · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
 10REM MapMaker V1.1 - Make, Modify, Load and Save a bitmap game field
 20REM by 8BitVino
 30REM https://github.com/8BitVino/mapmaker
 40REM with code snippets from The-8bit-Noob & robogeek42
 50 MB%=&40000 : REM MEMORY BANK &40000.
 60DIM graphics 1024
 70DIM the_map%(14,14)
 80DIM custompack$(9)
 90DIM customslot%(9)
 100 XSIZE%=14:YSIZE%=14:x%=112:y%=112:ink%=1:sticky%=1
 110 p%=0:lega%=10:legb%=20:slot%=0:decks%=4:deckz%=40:V$="Version 1.1"
 120 custom%=0:clslot%=0:tilespack$="tiles"
 130 VDU 23,27,16 : REM CLEAR ALL SPRITE DATA.
 140 MODE 8 : REM SET SCREEN MODE.
 150 VDU 23,1,0 : REM DISABLE CURSOR.
 160 PROCsetupChars
 170FOR T=0TO148:C.RND(32):P."MAPMAKER";:NEXT:PROCborder
 180 C.7:P.TAB(7,13);"M A P M A K E R":C.20:P.TAB(10,14);V$
 190 PROCnumdecks
 200 C.15:P.TAB(6,16);"Reticulating splines"
 210 PROCgreenstart:PROCloadbitmaps:PROCreload:PROCmenulist
 220 VDU 23,27,0,0 :REM show cursor in middle at start
 230 VDU 23,27,3,x%;y%;
 240ONERROR PROCshowmap:GOTO250 :REM used to stop Escape key from stopping program and refreshes instead
 250 A%=INKEY(0) : REM GET KEYBOARD INPUT FROM PLAYER.
 260IF A%=21THEN PROCclearmove:PROCmoveright:PROCnewcursor :REM MOVE SPRITE RIGHT.
 270IF A%=8THEN PROCclearmove:PROCmoveleft:PROCnewcursor :REM MOVE SPRITE LEFT.
 280IF A%=10THEN PROCclearmove:PROCmoveup:PROCnewcursor :REM MOVE SPRITE DOWN.
 290IF A%=11THEN PROCclearmove:PROCmovedown:PROCnewcursor :REM MOVE SPRITE UP.
 300IF A%=49THEN PROClay(0+lega%):REM 1
 310IF A%=50THEN PROClay(1+lega%):REM 2
 320IF A%=51THEN PROClay(2+lega%):REM 3
 330IF A%=52THEN PROClay(3+lega%):REM 4
 340IF A%=53THEN PROClay(4+lega%):REM 5
 350IF A%=54THEN PROClay(5+lega%):REM 6
 360IF A%=55THEN PROClay(6+lega%):REM 7
 370IF A%=56THEN PROClay(7+lega%):REM 8
 380IF A%=57THEN PROClay(8+lega%):REM 9
 390IF A%=48THEN PROClay(9+lega%):REM 0
 400IF A%=113OR A%=81THEN PROClay(0+legb%):REM q
 410IF A%=119OR A%=87THEN PROClay(1+legb%):REM w
 420IF A%=101OR A%=69THEN PROClay(2+legb%):REM e
 430IF A%=114OR A%=82THEN PROClay(3+legb%):REM r
 440IF A%=116OR A%=84THEN PROClay(4+legb%):REM t
 450IF A%=121OR A%=89THEN PROClay(5+legb%):REM y
 460IF A%=117OR A%=85THEN PROClay(6+legb%):REM u
 470IF A%=105OR A%=73THEN PROClay(7+legb%):REM i
 480IF A%=111OR A%=79THEN PROClay(8+legb%):REM o
 490IF A%=80OR A%=112THEN PROClay(9+legb%):REM p
 500IF A%=76OR A%=108THEN PROCloadmap::REM (L)OAD
 510IF A%=86OR A%=118THEN PROCsavemap::REM SA(V)E
 520IF A%=120OR A%=88THEN PROCcheckexit :REM (X) Exit
 530IF A%=90OR A%=122THEN PROCzoneload:REM (Z) for tile load WRONG KEYS
 540IF A%=78OR A%=110THEN PROCrandommap:REM ra(N)dom map
 550IF A%=75OR A%=107THEN PROCpenflow :REM toggle ink (K)
 560IF A%=91 PROClegendleft :REM LEFT LEGEND REFRESH ([)
 570IF A%=93 PROClegendright :REM RIGHT LEGEND REFRESH (])
 580IF A%=68OR A%=64THEN PROCdirs :REM (D)
 590IF A%=63OR A%=47THEN PROCinfo :REM (?)
 600IF A%=67OR A%=99THEN PROCclearmap :REM (C)ls
 610GOTO250
 620 ENDPROC
 630 DEFPROCclearmap
 640 PROCborder
 650 C. 15:PRINTTAB(6,14);"CLEAR MAP":PRINTTAB(6,16);"Are you sure?":PRINTTAB(6,18);"Press Y to confirm"
 660 N$=GET$
 670IF N$="y"OR N$="Y"THEN PROCgreenstart
 680 PROCrefresh
 690 ENDPROC
 700 DEFPROCclearmove
 710 XCORD%=x%MOD15 : REM Clever maths. Finds XCORD% by doing array value MODULUS 15.
 720 YCORD%=y%DIV15 : REM Clever maths. Finds YCORD% by doing array value DIV by 15.
 730 w%=the_map%(YCORD%,XCORD%) :REM find the object to restore. Why is X Y reversed?
 740 PROCclearcell
 750 VDU 23,27,0,w% :REM select the graphic
 760 VDU 23,27,3,x%;y%; :REM paste sprite in location
 770 ENDPROC
 780 DEFPROCnewcursor :REM put the original bitmap back
 790 LOCAL XXCORD%,YYCORD%
 800 XXCORD%=x%MOD15 : REM Clever maths. Finds XCORD% by MODULUS 15.
 810 YYCORD%=y%DIV15 : REM Clever maths. Finds YCORD% by DIV 15.
 820 H%=the_map%(YYCORD%,XXCORD%)
 830 C. 15:PRINTTAB(32,6);"tile:";H%
 840 VDU 23,27,0,0 :REM select the tranparency box
 850 VDU 23,27,3,x%;y%; :REM paste sprite in location
 860 ENDPROC
 870 DEFPROCmoveright
 880IF x%=224THEN x%=0:GOTO900 :REM far right boundary
 890 x%=x%+16
 900 PROCinkcheck
 910 ENDPROC
 920 DEFPROCmoveleft
 930IF x%=0THEN x%=224:GOTO950 :REM far left boundary
 940 x%=x%-16
 950 PROCinkcheck
 960 ENDPROC
 970 DEFPROCmoveup
 980IF y%=224THEN y%=0:GOTO1000 :REM bottom boundary
 990 y%=y%+16
 1000 PROCinkcheck
 1010 ENDPROC
 1020 DEFPROCmovedown
 1030IF y%=0THEN y%=224:GOTO1050 :REM top boundary
 1040 y%=y%-16
 1050 PROCinkcheck
 1060 ENDPROC
 1070 DEFPROClegendleft
 1080 lega%=lega%+10
 1090IF lega%=deckz% THEN lega%=10
 1100 PROCrefresh
 1110 ENDPROC
 1120 DEFPROClegendright
 1130 legb%=legb%+10
 1140IF legb%=deckz% THEN legb%=10
 1150 PROCrefresh
 1160 ENDPROC
 1170 DEFPROClegend
 1180 C.1:PRINTTAB(30,8);"[";SPC(8);"]"
 1190 C.15:PRINTTAB(31,8);lega%DIV10
 1200 PRINTTAB(37,8);legb%DIV10
 1210 C.2:PRINTTAB(33,8)"BANK"
 1220 R%=72
 1230FOR Q=0TO9
 1240 VDU23,27,0,Q+lega% :REM COLUMN 1
 1250 VDU23,27,3,247;R%;
 1260 VDU23,27,0,Q+legb% :REM COLUMN 2
 1270 VDU23,27,3,277;R%;
 1280 R%=R%+17
 1290NEXT
 1300 ENDPROC
 1310 DEFPROCmenulist
 1320 COLOUR8:D%=700
 1330 VDU 5 :REM ALLOW TEXT IN GFX
 1340FOR H=1TO9:MOVE 1060,D%:PRINT;H:D%=D%-73:NEXT
 1350 MOVE 1060,43:PRINT"0"
 1360 MOVE1188,702:P."Q":MOVE1188,628:P."W":MOVE1188,553:P."E":MOVE1188,481:P."R":MOVE1188,402:P."T"
 1370 MOVE1188,328:P."Y":MOVE1188,262:P."U":MOVE1188,184:P."I":MOVE1188,117:P."O":MOVE1188,50:P."P"
 1380 VDU 4 :REM STOP TEXT IN GFX
 1390 COLOUR5:P.TAB(39,9);:VDU243:P.TAB(39,11);"M":P.TAB(39,13);"A":P.TAB(39,15);"P":P.TAB(39,18);"M"
 1400 P.TAB(39,20);"A":P.TAB(39,22);"K":P.TAB(39,24);"E":P.TAB(39,26);"R":P.TAB(39,28);:VDU244
 1410 COLOUR1:PRINTTAB(35,0);:VDU240,243,244,242:COLOUR2:PRINTTAB(30,0);"Move"
 1420 PROCshort(30,1,"","L","oad"):PROCshort(35,1,"sa","V","e")
 1430 PROCshort(30,2,"e","X","it"):PROCshort(35,2,"ra","N","d")
 1440 PROCshort(30,3,"","Z","one"):PROCshort(35,3,"","D","irs")
 1450 PROCshort(30,4,"stic","K","y"):PROCshort(34,5,"","?",""):PROCshort(30,5,"","C","LS")
 1460 ENDPROC
 1470 DEFPROClay(H%)
 1480 sticky%=H% :REM set the sticky value
 1490 PRINTTAB(31,6);SPC(9) :REM clear dialog box
 1500 COLOUR15:PRINTTAB(32,6);"tile:";H%
 1510 PROCclearcell
 1520 VDU 23,27,0,H% :REM select the box
 1530 VDU 23,27,3,x%;y%; :REM movebox to new location
 1540 XCORD%=x%MOD15 : REM Clever maths. Finds XCORD% by MODULUS 15.
 1550 YCORD%=y%DIV15 : REM Clever maths. Finds YCORD% by DIV 15.
 1560 the_map%(YCORD%,XCORD%)=H%
 1570 ENDPROC
 1580 DEFPROCshort(x,y,pre$,hi$,post$)
 1590 PRINTTAB(x,y);:C.2:P.pre$;:C.1:P.hi$;:C.2:P.post$;
 1600 ENDPROC
 1610 DEFPROCloadbitmaps
 1620 C. 15
 1630 PROCload_bitmap("0","0",0,16,16) :REM LOAD THE TRANSPARENT CUBE FROM DIR 0
 1640 PROCload_bitmap("0","1",1,16,16) :REM LOAD THE BLACK TILEFROM DIR 0
 1650 PRINTTAB(17,18);"/ ";deckz% :REM fix this based on decks%
 1660FOR R%=1TO decks%
 1670FOR L%=0TO9
 1680 p%=R%*10:p%=p%+L% :REM POPULATES SLOT
 1690 PROCload_bitmap(STR$(R%),STR$(L%),p%,16,16) :REM directory, filename, sprite number
 1700NEXT
 1710NEXT
 1720 ENDPROC
 1730 DEFPROCload_bitmap(D$,F$,N%,W%,H%)
 1740IF N%=9THEN PRINTTAB(15,18);" "
 1750 PRINTTAB(13,18);N% :REM SHOW LOAD SPRITE
 1760 OSCLI("LOAD "+ D$ +"/"+ F$ +".rgb"+" "+STR$(MB%+graphics))
 1770 VDU 23,27,0,N% : REM SELECT SPRITE n (equating to buffer ID numbered 64000+n).
 1780 VDU 23,27,1,W%;H%; : REM LOAD COLOUR BITMAP DATA INTO CURRENT SPRITE.
 1790FOR I%=0TO (W%*H%*4)-1 STEP 4 : REM LOOP 16x16x3 EACH PIXEL R,G,B,A
 1800 r% = ?(graphics+I%+0) : REM RED DATA.
 1810 g% = ?(graphics+I%+1) : REM GREEN DATA.
 1820 b% = ?(graphics+I%+2) : REM BLUE DATA.
 1830 a% = ?(graphics+I%+3) : REM ALPHA (TRANSPARENCY)
 1840 VDU r%, g%, b%, a%
 1850NEXT
 1860 ENDPROC
 1870 DEFPROCshowmap
 1880 LOCAL XLOC%,YLOC%
 1890FOR j=0TOYSIZE%
 1900FOR i=0TOXSIZE%
 1910 g%=the_map%(i,j)
 1920 VDU 23,27,0,g% : REM select the specified bitmap
 1930 VDU 23,27,3,YLOC%;XLOC%; : REM displays the bitmap
 1940 XLOC%=XLOC%+16 :REM update the X location to move to the right
 1950IF i=14THEN YLOC%=YLOC%+16:XLOC%=0 :REM at end of row move to start next line and down
 1960NEXT
 1970NEXT
 1980 PROCnewcursor :REM always reshow the cursor on a showmap
 1990 ENDPROC
 2000 DEFPROCrandommap
 2010FOR i=0TOXSIZE%:FOR j=0TOYSIZE%
 2020 the_map%(i,j)=RND(deckz%-10)+10:NEXT:NEXT
 2030 PROCrefresh
 2040 ENDPROC
 2050 DEFPROCsavemap
 2060 PROCborder
 2070INPUTTAB(7,14) "Save map filename?",TAB(7,16) FILENAME$
 2080 A=OPENOUT FILENAME$
 2090PRINT#A,XSIZE%
 2100PRINT#A,YSIZE%
 2110PRINT#A,decks% :REM output number of decks in use
 2120PRINT#A,custom% :REM output number of custom zones in use
 2130FOR i=0TOXSIZE%
 2140FOR j=0TOYSIZE%
 2150PRINT#A,the_map%(i,j)
 2160NEXT
 2170NEXT
 2180IF custom%>0THEN PROCcustomsave
 2190CLOSE#A
 2200 PROCanykey
 2210 PROCrefresh
 2220 ENDPROC
 2230 DEFPROCcustomsave
 2240FOR G%=0TO custom%-1 :REM loop for number of saved custom
 2250PRINT#A,custompack$(G%)
 2260PRINT#A,customslot%(G%)
 2270NEXT
 2280 ENDPROC
 2290 DEFPROCloadmap
 2300 LOCAL XIMP%,YIMP%
 2310 PROCborder
 2320 C. 15:INPUTTAB(7,14) "Load map filename?",TAB(7,16) FILENAME$
 2330 fnum=OPENIN FILENAME$
 2340IF fnum=0THEN PRINTTAB(7,14);"Filename NOT loaded":GOTO2480
 2350INPUT#fnum,XIMP% :REM Read X map size
 2360INPUT#fnum,YIMP% :REM Read Y map size
 2370INPUT#fnum,decks% :REM load the number of decks in use
 2380INPUT#fnum,custom% :REM read number of custom tile slots
 2390FOR i=0TOXIMP% :REM read map based on defined size
 2400FOR j=0TOYIMP%
 2410INPUT#fnum,the_map%(i,j) :REM save to map
 2420NEXT
 2430NEXT
 2440 deckz%=decks%*10+10
 2450 PRINTTAB(7,16);"Loading tiles..."
 2460 PROCloadbitmaps :REM reloading base bitmaps (needed because decks%)
 2470IF custom%>0THEN PROCcustomload
 2480CLOSE#fnum
 2490 PROCanykey:PROCrefresh
 2500 ENDPROC
 2510 DEFPROCcustomload
 2520 PRINTTAB(7,16);"Loading extras..."
 2530 PRINTTAB(19,18);custom%*10+10
 2540FOR G%=0TO custom%-1 :REM loop for number of saved custom
 2550INPUT#fnum,clpack$
 2560INPUT#fnum,clslot%
 2570FOR L%=0TO9
 2580 PROCload_bitmap(clpack$,STR$(L%),(clslot%+L%),16,16) :REM directory, filename, sprite number
 2590NEXT
 2600 custompack$(G%)=clpack$ :REM replay into the custom tilepack
 2610 customslot%(G%)=clslot% :REM replay into the slot
 2620NEXT
 2630 ENDPROC
 2640 DEFPROCgreenstart
 2650FOR i=0TOYSIZE%:FOR j=0TOXSIZE%:the_map%(i,j)=1:NEXT:NEXT
 2660 ENDPROC
 2670 DEFPROCsetupChars
 2680 VDU 23,240,0,&20,&40,&FF,&40,&20,0,0 : REM left arrow
 2690 VDU 23,242,0,&04,&02,&FF,&02,&04,0,0 : REM right
 2700 VDU 23,243,&10,&38,&54,&10,&10,&10,&10,0 : REM up
 2710 VDU 23,244,&10,&10,&10,&10,&54,&38,&10,0 : REM down
 2720 VDU 23,230,255,255,255,255,255,255,255,255 :REM block
 2730 ENDPROC
 2740 DEFPROCzoneload
 2750 PROCborder
 2760IF custom%>9THEN COLOUR9:PRINTTAB(9,15);"Exceeded max":PRINTTAB(7,17);"custom slot limit":GOTO2870
 2770 C. 15:INPUTTAB(7,14) "Load tile pack?",TAB(7,15) "(enter dir name)", TAB(7,17) tilespack$
 2780 PRINTTAB(7,17);SPC(16):INPUTTAB(7,14) "Which slot? ",TAB(7,15) "(enter slot number)", TAB(7,17) slot%
 2790IF slot%<1OR slot%>decks% THEN COLOUR9:PRINTTAB(7,19);"Invalid slot. retry":GOTO2780
 2800 slot%=slot%*10
 2810FOR L%=0TO9
 2820 PROCload_bitmap(tilespack$,STR$(L%),(slot%+L%),16,16) :REM directory, filename, sprite number
 2830NEXT
 2840 custompack$(custom%)=tilespack$ :REM ASSIGN the tilepack used to custompack
 2850 customslot%(custom%)=slot% :REM record the slot 10-990
 2860 custom%=custom%+1
 2870 PROCreload
 2880 ENDPROC
 2890 DEFPROCborder
 2900FOR G=12TO20 STEP 1:COLOUR0:PRINTTAB(5,G);SPC(22):COLOUR6:PRINTTAB(4,G);CHR$230:PRINTTAB(27,G);CHR$230:NEXT
 2910 COLOUR6:PRINTTAB(5,12);STRING$(22,CHR$230):PRINTTAB(5,20);STRING$(22,CHR$230)
 2920 ENDPROC
 2930 DEFPROCcheckexit
 2940 PROCborder
 2950 C. 15:PRINTTAB(7,14);"Quit:Are you sure?":PRINTTAB(7,16);"Press Y to confirm"
 2960 N$=GET$
 2970IF N$="y"OR N$="Y"THENGOTO3430
 2980 PROCshowmap
 2990 ENDPROC
 3000 DEFPROCrefresh
 3010CLS:PROClegend:PROCshowmap:PROCmenulist
 3020 ENDPROC
 3030 DEFPROCreload
 3040 PROCrefresh:PROCpenflow
 3050 ENDPROC
 3060 DEFPROCpenflow
 3070IF ink%=0THEN ink%=1:COLOUR10:PRINTTAB(37,4);"ON ":GOTO3090
 3080 ink%=0:COLOUR1:PRINTTAB(37,4);"OFF"
 3090 ENDPROC
 3100 DEFPROCinkcheck
 3110IF ink%=1THEN PROCclearcell:PROClay(sticky%)
 3120 ENDPROC
 3130 DEFPROCclearcell
 3140 VDU 23,27,0,1 :REM CLEAR WITH BLACK FRAME
 3150 VDU 23,27,3,x%;y%; :REM PASTE BLACK FRAME
 3160 ENDPROC
 3170 DEFPROCnumdecks
 3180 C.15:PRINTTAB(8,19);"(5 recommended)"
 3190INPUTTAB(6,16) "How many tile packs?",TAB(15,18) decks%
 3200IF decks%<2OR decks%>99THEN COLOUR 9:PRINTTAB(7,19);"Invalid. try again":GOTO3190
 3210 deckz%=decks%*10+10
 3220 PRINTTAB(9,17);SPC(16):PRINTTAB(15,18);SPC(10):PRINTTAB(7,19);SPC(18)
 3230 ENDPROC
 3240 DEFPROCdirs
 3250 PROCborder:COLOUR15:PRINTTAB(6,13);"Custom slot dirs"
 3260FOR T%=0TO4
 3270 PRINTTAB(5,15+T%);T%+1;" ";custompack$(T%)
 3280 PRINTTAB(15,15+T%);T%+6;" ";custompack$(T%+5)
 3290NEXT
 3300 temp=GET
 3310 PROCrefresh
 3320 ENDPROC
 3330 DEFPROCinfo
 3340 PROCborder
 3350 COLOUR15:PRINTTAB(6,13);"Mapmaker ";V$
 3360 PRINTTAB(6,15);"See readme.txt"
 3370 PRINTTAB(6,16);"for instructions"
 3380 PROCanykey:PROCrefresh
 3390 ENDPROC
 3400 DEFPROCanykey
 3410 PRINTTAB(7,18);"Press any key...":temp=GET
 3420 ENDPROC
 3430CLS:P."GOODBYE!":END