innes@unccvax.UUCP (Norm Innes) (12/19/85)
The following is a little less than 500 lines of ABasiC source. It's a simple paint program, but fun to work with. It will run in either low (320 x 200) or high-res (640 x 200), but is a good bit faster (more responsive) in low-res - the saved screens also use much less disk. In the color cycle mode, it's fairly easy to simulate motion (use consecutive colors for the spokes of a wheel, for example). Colors can also be mixed using the pattern selector (every other pixel for each of the last 2 colors selected). In high-res, this results in more than 16 effective colors. Enjoy... -------------------------------------------------------------------- 1000 'PAINTBOX - A simple drawing program. 1100 'Designed for the Amiga, V1.0, 512K, using ABasiC 1200 ' 1300 ' Check resolution of current screen, so we can restore it 1400 ' when we finish and invoke a new screen only if needed 1500 IF PIXEL(600,0)<0 THEN OLDRES%=320 ELSE OLDRES%=640 1600 ' Get resolution desired for this run 1700 GRAPHIC(0): RES%=0 1800 WHILE RES%=0 1900 PRINT "Select resolution (Hi/Lo) " 2000 INPUT C$: C$=LEFT$(C$,1) 2100 IF C$="H" OR C$="h" THEN RES%=640 2200 IF C$="L" OR C$="l" THEN RES%=320 2300 WEND 2400 CLR 2500 ' SAVBOX% - Holds copy of selection area of screen, so it 2600 ' can be easily restored if window is resized 2700 ' OLDCOLOR% - Colors to restore to original screen 2800 ' COLORS% - Program colors 3 thru 14 (for color cycling) 2900 ' PAT1% - Used to define solid paint pattern 3000 ' PAT2% - Used for "dotty" paint pattern (every other pixel) 3100 DIM SAVBOX%(1123),OLDCOLOR%(15),COLORS%(11),PAT1%(1),PAT2%(1) 3200 RES2%=RES%/320 'For hi-res aspect ratio for circles 3300 LIM%=RES%-17 'Right limit of useable window 3400 IF RES%<>OLDRES% THEN SCREEN RES%\640,4,0 3500 WINDOW #1,0,0,RES%,200,"PAINTBOX " 3600 ON ERROR GOTO 48400 3700 CMD #1: FONT 1: GRAPHIC(1): DRAWMODE 0: AUDIO 3,1 3800 TRUE=-1: FALSE=0 'For convenience 3900 ' Save current screen colors 4000 FOR I=0 TO 15 4100 ASK RGB I,X1%,X2%,X3% 4200 OLDCOLOR%(I)=(X1%*32+X2%)*32+X3%: NEXT 4300 ' Set colors for Paintbox 4400 RGB 0, 6, 6, 6 'Dark grey (background) 4500 RGB 1, 0, 0, 0 'Black 4600 RGB 2,10,10,10 'Light grey 4700 RGB 3,10, 0, 7 'Purple 4800 RGB 4,15, 8, 8 'Pink 4900 RGB 5,15, 0, 0 'Red 5000 RGB 6,15, 5, 0 'Orange 5100 RGB 7, 6, 2, 0 'Brown 5200 RGB 8,15,12, 0 'Yellow 5300 RGB 9, 6,12, 0 'Light green 5400 RGB 10, 0, 4, 0 'Dark green 5500 RGB 11, 0,10, 9 'Aqua 5600 RGB 12, 0, 0,12 'Blue 5700 RGB 13, 4, 6,15 'Light Blue 5800 RGB 14, 8, 0,12 'Violet 5900 RGB 15,15,15,15 'White (XOR of background color) 6000 FOR I=0 TO 11 6100 ASK RGB I+3,X1%,X2%,X3% 6200 COLORS%(I)=(X1%*32+X2%)*32+X3%: NEXT 6300 ' Make color selection boxes 6400 PENO 1 6500 FOR Y%=0 TO 120 STEP 10 6600 PENA Y%/10+3: BOX(0,Y%;20,Y%+10),1: NEXT 6700 PENA 1: BOX(21,110;45,120),1 6800 PENA 2: BOX(21,120;45,130),1 6900 ' Make style selection boxes 7000 FOR Y%=0 TO 100 STEP 10 7100 BOX(21,Y%;45,Y%+10): NEXT 7200 ' Show brush widths 7300 PENA 2: OUTLINE 0: DRAW(29,1 TO 37,9) 7400 AREA(26,11 TO 32,11 TO 40,19 TO 34,19) 7500 AREA(24,21 TO 34,21 TO 42,29 TO 32,29) 7600 AREA(22,31 TO 36,31 TO 44,39 TO 30,39) 7700 ' Moveable line 7800 DRAW(26,45 TO 39,45): DRAW(25,45),15: DRAW(40,45),15 7900 ' Lines radiating from a point 8000 AREA(26,52 TO 41,52 TO 36,57) 8100 DRAW(26,52),15: DRAW(41,52 TO 36,57),15 8200 ' Area color/pattern fill 8300 PENA 13: PENO 2: AREA(26,62 TO 43,63 TO 38,68 TO 26,68) 8400 ' Sizeable circle 8500 CIRCLE(33,75),4: DRAW(33,75),15 8600 ' Sizeable rectangle 8700 BOX(25,82;40,88): DRAW(25,82),15: DRAW(40,88),15 8800 ' Set/reset pattern 8900 PAT1%(0)=&HFFFF: PAT1%(1)=&HFFFF 9000 PAT2%(0)=&HAAAA: PAT2%(1)=&H5555 9100 PATTERN 2,PAT2%: DRAWMODE 1 9200 PENA 2: PENB 0: PENO 0: BOX(22,91;44,99),1 9300 PATTERN 2,PAT1%: DRAWMODE 0: DOTTY=FALSE 9400 ' Color cycle 9500 FOR COLOR=3 TO 13 9600 PENO COLOR: BOX(16+2*COLOR,101;17+2*COLOR,109): NEXT 9700 PENA 14: DRAW(44,101 TO 44,109) 9800 ' Action boxes 9900 PENA 1: PENO 1 10000 BOX(0,130;45,140): PRINT AT(3,138);"Erase" 10100 BOX(0,140;45,150): PRINT AT(3,148);"Clear" 10200 BOX(0,150;45,160): PRINT AT(7,158);"Save" 10300 BOX(0,160;45,170): PRINT AT(7,168);"Load" 10400 BOX(0,170;45,186): PRINT AT(7,181);"Exit" 10500 ' Initialize starting values 10600 W%=LIM%: H%=187 10700 COLOR=0: LASTCOLOR=0 10800 ' Save selection area 10900 SSHAPE(0,0;47,187),SAVBOX% 11000 ' Set background grey level 11100 ASK MOUSE X%,Y%,L% 11200 STYLE=-1: X%=120: SLIDE%=120: GOSUB 14300 11300 ' 11400 ' Main loop - always return here or at next statement 11500 ' 11600 WHILE L%>0: ASK MOUSE X%,Y%,L%: WEND 11700 ASK MOUSE X%,Y%,L%: Y%=Y%-1 'Fix Y% to align better with pointer 11800 GOSUB 17400 'See if window has been resized 11900 IF L%=0 OR X%<0 OR X%=46 OR X%>W% OR Y%<0 OR Y%>H% GOTO 11700 12000 IF STYLE<0 THEN GOSUB 14300: GOTO 11600 12100 IF X%<=45 GOTO 12700 'Make selection 12200 IF STYLE=0 GOTO 11600 12300 ' Paint in various widths 12400 IF STYLE <=4 THEN GOSUB 19200: GOTO 11700 12500 ' --------------Line Lines Fill Circle Box 12600 ON STYLE-4 GOSUB 20500,21800,22800,23500,24800: GOTO 11700 12700 IF Y%<130 GOTO 13200 'Color/style selection 12800 IF Y%<140 THEN GOSUB 25900: GOTO 11600 'Erase 12900 ' ---------------Clear Save Load Exit Exit 13000 ON Y%\10-13 GOSUB 27000,28600,31300,39700,39700: GOTO 11700 13100 ' Select color 13200 IF X%<21 OR Y%>=110 THEN GOSUB 40800: GOTO 11600 13300 ' Select style 13400 IF Y%<90 THEN GOSUB 42800: GOTO 11600 13500 ' Set/reset pattern 13600 IF Y%<100 THEN GOSUB 43500: GOTO 11600 13700 ' Cycle colors 13800 GOSUB 44700: GOTO 11600 13900 ' 14000 ' ----------------- Subroutines ----------------- 14100 ' 14200 ' Set grey level for background (in range 4-11) 14300 PENA 12: PENO 1: BOX(58,33;86,45),1 'OK box (blue) 14400 PENA 1: PRINT AT(65,42);"OK" 14500 PRINT AT(100,42);"Background grey level" 14600 PENA 0: PENO 1: BOX(58,50;281,62),1 'Box for slider 14700 PENA 5: PENO 5: BOX(60,52;SLIDE%+9,60),1 'Slider 14800 IF X%<58 OR X%>86 OR Y%<36 OR Y%>48 GOTO 15200 'Check OK box 14900 PENA 0: PENO 0: BOX(58,33;281,62),1 'Clean up the screen 15000 PENB 0: STYLE=0: RETURN 'All done 15100 ' Better check the EXIT box too, in case user wants to quit 15200 IF X%>=0 AND X%<46 AND X%<W% AND Y%>169 AND Y%<H% THEN GOSUB 39700 15300 ' If on end of slider, track with mouse, else move by steps 15400 IF X%<SLIDE% OR X%>SLIDE%+9 OR Y%<51 OR Y%>61 GOTO 16200 15500 X3%=X%-SLIDE%: X%=SLIDE% 'X3%=offset from end-9 of slider 15600 WHILE L%>0 'Move slider to follow mouse 15700 IF X%=SLIDE% OR X%<60 OR X%>270 GOTO 15900 15800 G1%=(X%+15)\30+2: GOSUB 16600 15900 ASK MOUSE X%,Y%,L%: X%=X%-X3% 16000 WEND 16100 RETURN 16200 G1%=(SLIDE%+15)\30+2 'Current background intensity 16300 IF X%<SLIDE% AND G1%>4 THEN G1%=G1%-1 16400 IF X%>SLIDE%+9 AND G1%<11 THEN G1%=G1%+1 16500 X%=(G1%-2)*30 'New location for slider 16600 IF X%>SLIDE% THEN PENA 5: PENO 5: BOX(SLIDE%+9,52;X%+9,60),1 16700 IF X%<SLIDE% THEN PENA 0: PENO 0: BOX(X%+10,52;SLIDE%+9,60),1 16800 SLIDE%=X% 16900 G2%=G1%\2 - 8*(G1%<8) 'G1%=background, G2%=the other grey 17000 RGB 0,G1%,G1%,G1%: RGB 2,G2%,G2%,G2% 17100 RETURN 17200 ' 17300 ' Restore selection area if window is resized 17400 ASK WINDOW WIDTH%,HEIGHT%: IF W%=WIDTH% AND H%=HEIGHT% THEN RETURN 17500 GSHAPE(0,0),SAVBOX%: PENO 15: IF COLOR=0 GOTO 18000 17600 ' Restore white borders/red print, etc. for items selected 17700 IF COLOR<3 THEN BOX(21,10*(COLOR+10);45,10*(COLOR+11)) 17800 IF COLOR>2 THEN BOX(0,10*(COLOR-3);20,10*(COLOR-2)) 17900 IF COLOR=15 THEN PENO 1: BOX(1,121;19,129): PENO 15 18000 IF STYLE>0 THEN BOX(21,10*(STYLE-1);45,10*STYLE) 18100 IF DOTTY THEN PENA COLOR: PENB LASTCOLOR: BOX(22,91;44,99),1 18200 PENA 5: PENB 0: PENO 5 18300 IF PENDING=1 THEN BOX(0,140;45,150) 'Clear 18400 IF PENDING=2 THEN BOX(0,170;45,186) 'Exit 18500 IF PENDING=3 THEN PRINT AT(7,158);"Save" 18600 IF PENDING=4 THEN PRINT AT(7,168);"Load" 18700 IF ERASING THEN PRINT AT(3,138);"Erase" 18800 PENA COLOR: PENB LASTCOLOR: PENO COLOR: W%=WIDTH%: H%=HEIGHT% 18900 RETURN 19000 ' 19100 ' Various brush widths 19200 X1%=X%: Y1%=Y%: X3%=X1%-DX: IF X3%<47 THEN X3%=47 19300 OUTLINE 0 'Set to 1 for variable 2-color brush effect 19400 WHILE L%>0 19500 IF X%+DX<47 GOTO 19900 'Completely off screen 19600 X2%=X%-DX: IF X2%<47 THEN X2%=47 'Slightly off screen 19700 AREA(X3%,Y1%+DY TO X1%+DX,Y1%-DY TO X%+DX,Y%-DY TO X2%,Y%+DY) 19800 X1%=X%: X3%=X2% 19900 Y1%=Y%: ASK MOUSE X%,Y%,L%: Y%=Y%-1: WEND 20000 RETURN 20100 ' 20200 ' Moveable line. Each DRAW complements the current colors, 20300 ' so two DRAW's will restore the original. The same process 20400 ' is used for circles and rectangles in other routines 20500 X1%=X%: Y1%=Y%: X2%=X%: Y2%=Y% 20600 DRAWMODE 2: DRAW(X1%,Y1%) 20700 WHILE L%>0 20800 IF X2%=X% AND Y2%=Y% GOTO 21100 20900 DRAW(X1%,Y1% TO X2%,Y2%): DRAW(X1%,Y1% TO X%,Y%) 21000 X2%=X%: Y2%=Y% 21100 ASK MOUSE X%,Y%,L%: Y%=Y%-1: IF X%<47 THEN X%=47 21200 WEND 21300 ' Finished - now reset DRAWMODE and draw the final line 21400 DRAWMODE ABS(DOTTY): DRAW(X1%,Y1% TO X2%,Y2%) 21500 RETURN 21600 ' 21700 ' All lines from a point 21800 X1%=X%: Y1%=Y% 21900 WHILE L%>0 22000 DRAW(X1%,Y1% TO X%,Y%) 22100 ASK MOUSE X%,Y%,L%: Y%=Y%-1: IF X%<47 THEN X%=47 22200 WEND 22300 RETURN 22400 ' 22500 ' Area color/pattern fill. Will not fill over a previously 22600 ' pattern-filled area. Line at X=46 keeps fill in working 22700 ' portion of screen and prevents bleeding into adjoining areas 22800 IF PIXEL(X%,Y%)=0 THEN DRAW(46,0 TO 46,187),2 22900 PAINT(X%,Y%),1: DRAW(46,0 TO 46,187),0 23000 WHILE L%>0: ASK MOUSE X%,Y%,L%: WEND 23100 RETURN 23200 ' 23300 ' Variable sized circle. RES2% handles the x-y aspect 23400 ' ration for high res screens 23500 X1%=X%: Y1%=Y%: X2%=X%: Y2%=Y%: R2%=0: DRAWMODE 2 23600 WHILE L%>0 23700 IF X%=X2% AND Y%=Y2% GOTO 24200 23800 R%=SQR(((X1%-X%)/RES2%)**2+(Y1%-Y%)**2) 23900 IF X1%-R%*RES2%<47 THEN R%=(X1%-47)/RES2% 'Left limit of circle 24000 CIRCLE(X1%,Y1%),R2%: CIRCLE(X1%,Y1%),R% 24100 X2%=X%: Y2%=Y%: R2%=R% 24200 ASK MOUSE X%,Y%,L%: Y%=Y%-1: IF X%<47 THEN X%=47 24300 WEND 24400 DRAWMODE ABS(DOTTY): CIRCLE(X1%,Y1%),R2% 24500 RETURN 24600 ' 24700 ' Sizeable rectangle 24800 X1%=X%: Y1%=Y%: X2%=X%: Y2%=Y%: DRAWMODE 2 24900 WHILE L%>0 25000 IF X%=X2% AND Y%=Y2% GOTO 25300 25100 BOX(X1%,Y1%;X2%,Y2%): BOX(X1%,Y1%;X%,Y%) 25200 X2%=X%: Y2%=Y% 25300 ASK MOUSE X%,Y%,L%: Y%=Y%-1: IF X%<47 THEN X%=47 25400 WEND 25500 DRAWMODE ABS(DOTTY): BOX(X1%,Y1%;X2%,Y2%) 25600 RETURN 25700 ' 25800 ' Erase 25900 ERASING=TRUE: IF DOTTY THEN GOSUB 43500 'Turn off pattern 26000 PENA 5: PRINT AT(3,138);"Erase" 'In red 26100 IF COLOR=0 GOTO 26600 26200 ' Remove white border around previously selected color 26300 PENO 1: IF COLOR<3 THEN BOX(21,10*(COLOR+10);45,10*(COLOR+11)) 26400 IF COLOR>2 THEN BOX(0,10*(COLOR-3);20,10*(COLOR-2)) 26500 IF COLOR=15 THEN PENO 15: BOX(1,121;19,129) 26600 COLOR=0: PENA 0: PENO 0 26700 RETURN 26800 ' 26900 ' Clear - Insists on a second click (to avoid accidental clear) 27000 PENO 5: BOX(0,140;45,150): PENDING=1 'Window resize uses PENDING 27100 WHILE L%>0: ASK MOUSE X%,Y%,L%: WEND 'Wait for button release 27200 ' Wait for next click - GOSUB call checks for window resizing 27300 WHILE L%=0: ASK MOUSE X%,Y%,L%: GOSUB 17400: WEND 27400 PENO 1: BOX(0,140;45,150): PENDING=0: Y%=Y%-1 27500 ' Make sure the mouse is still in the CLEAR box 27600 IF X%<0 OR X%>45 OR X%>W% OR Y%<140 OR Y%>=150 OR Y%>H% GOTO 28000 27700 FOR X%=0 TO 93 'Add some pizazz to the clear 27800 PENO 15: BOX(47+X%,1+X%;LIM%-X%-1,186-X%) 27900 PENO 0: BOX(46+X%,X%;LIM%-X%,187-X%): NEXT 28000 W%=0: GOSUB 17400 28100 RETURN 28200 ' 28300 ' Save screen to disk. This, as well as LOAD, are a bit 28400 ' memory hungry. Better not try resizing the window while 28500 ' this is going on, else GURU MEDITATION may result. 28600 IF RES%=320 THEN DIM A%(5985) ELSE DIM A%(13466) 28700 PENA 5: PENB 0: PRINT AT(7,158);"Save" 28800 SSHAPE(47,0;LIM%,187),A% 'Save active area in A% 28900 ' PENDING is used to restore screen if window is resized 29000 ' NOFILE is used in checking if the file already exists 29100 ' CANCEL is set if the user cancels the save operation 29200 ' OK=1 if the file already exists, =2 if OK to replace it 29300 PENDING=3: NOFILE=FALSE: CANCEL=FALSE: OK=0 29400 GOSUB 33500 'Get name desired for the file 29500 IF CANCEL GOTO 30600 29600 IF OK=2 GOTO 30400 29700 ' If file not found, gets "ON ERROR" and returns below 29800 OPEN "I",#2,NAME$: CLOSE #2 29900 PENA 5: PENB 5: PENO 1: BOX(75,69;183,91),1: PENA 1 30000 PRINT AT(78,78);"OK TO REPLACE": PRINT AT(78,88);"EXISTING FILE" 30100 OK=1: NOFILE=TRUE: GOSUB 35600: GOTO 29500 30200 ' No file, disk full or BSAVE I/O error returns here 30300 IF ERR=57 GOTO 30600 'Disk full or I/O error 30400 IF RES%=320 THEN I=23944 ELSE I=53868 30500 BSAVE NAME$,VARPTR(A%(0)),I 'Write disk file 30600 GSHAPE(47,0),A%: ERASE A% 'Restore screen 30700 PENA 1: PENB 0: PRINT AT(7,158);"Save" 30800 ' Play safe in case window resized while doing disk I/O 30900 PENDING=0: W%=0: GOSUB 17400 31000 RETURN 31100 ' 31200 ' Load disk file 31300 DIM A%(13466) 'Big enough for hi-res or lo-res file 31400 PENA 5: PENB 0: PRINT AT(7,168);"Load" 31500 SSHAPE(47,0;LIM%,187),A% 31600 PENDING=4: NOFILE=FALSE: CANCEL=FALSE: GOSUB 33500 31700 IF CANCEL GOTO 32600 31800 NOFILE=TRUE: BLOAD NAME$,VARPTR(A%(0)): GOTO 32600 31900 ' BLOAD error returns here 32000 IF ERR=57 GOTO 32600 'Disk I/O error 32100 PENA 5: PENB 5: PENO 5: BOX(79,75;179,85),1 32200 PENA 15: PRINT AT(82,83);"NO SUCH FILE" 32300 NOFILE=TRUE: GOSUB 35600: GOTO 31700 32400 ' If hi-res file on lo-res screen, only left half will show 32500 ' If lo-res file on hi-res screen, only half of screen is filled 32600 GSHAPE(47,0),A%: ERASE A% 32700 PENA 1: PENB 0: PRINT AT(7,168);"Load 32800 PENDING=0: W%=0: GOSUB 17400 'Just in case... 32900 RETURN 33000 ' 33100 ' File name requestor routine. We'll be looking for mouse 33200 ' clicks as well as character input, so use GET versus INPUT 33300 ' to receive the file name. If the window is resized too 33400 ' small to contain the CANCEL box, then cancel the operation. 33500 IF W%<240 THEN L%=SOUND(3,1,100,64,256): CANCEL=TRUE: RETURN 33600 PENB 2: PENO 2 33700 FOR I=0 TO 37 'Pop out the requestor box 33800 BOX(108-I,56-I;212+I,56+I): NEXT 33900 PENO 15: BOX(70,18;250,94) 34000 PENA 1: PRINT AT(100,35);"Enter file name" 34100 PENO 5: BOX(105,50;214,62) 34200 ' This little box is the "cursor", in yellow 34300 PENA 8: PENB 8: PENO 8: CURS=108: BOX(CURS,52;CURS+7,60),1 34400 PENA 12: PENB 12: PENO 1: BOX(186,74;239,86),1 34500 PENA 1: PRINT AT(189,83);"Cancel" 34600 ' Allowable file names (change it to suit your taste): 34700 ' First character must be a letter 34800 ' Remaining chars may be letters, numbers or . or - 34900 ' Maximum of 12 chars (plus "PAINT.", added by program) 35000 ' No two . or - may be adjoining 35100 ' May not end with . or - 35200 ' No embedded blanks allowed 35300 GET C$: IF C$<>"" GOTO 35300 'Clear any queued input 35400 NAME$="PAINT.": GOTO 35600 'Add the fixed prefix 35500 L%=SOUND(3,1,100,64,256) 'Beep if invalid entry 35600 GET C$: ASK MOUSE X%,Y%,L%: IF L%=0 GOTO 36500 35700 WHILE L%>0: ASK MOUSE X%,Y%,L%: WEND 'Wait for button release 35800 ' See if we're in the CANCEL box 35900 Y%=Y%-1 'For better pointer alignment 36000 IF X%>185 AND X%<240 AND Y%>73 AND Y%<87 THEN CANCEL=TRUE: RETURN 36100 ' or perhaps the OK TO REPLACE box 36200 IF X%<75 OR X%>183 OR Y%<69 OR Y%>91 GOTO 36500 36300 IF OK<>1 THEN OK=0 ELSE OK=2: GOTO 36800 36400 ' Check window resizing - cancel if too small 36500 GOSUB 17400: IF W%<240 OR H%<87 THEN CANCEL=TRUE: RETURN 36600 IF C$="" GOTO 35600 36700 IF NOT NOFILE GOTO 37000 'Else clear the last warning message 36800 PENA 2: PENB 2: PENO 2: BOX(75,69;183,91),1 36900 NOFILE=FALSE: IF OK<>2 THEN OK=0 ELSE RETURN 37000 IF LEN(NAME$)<7 GOTO 38300 'This must be the first character 37100 IF ASC(C$)<>13 GOTO 37400 '13=Carriage return 37200 IF RIGHT$(NAME$,1)<>"." AND RIGHT$(NAME$,1)<>"-" THEN RETURN 37300 GOTO 35500 'Trailing . or - not allowed 37400 IF ASC(C$)<>8 GOTO 37900 '8=Backspace 37500 NAME$=LEFT$(NAME$,LEN(NAME$)-1) 'Shorten name 37600 PENA 2: PENB 2: PENO 2: BOX(CURS,52;CURS+7,60),1 'Back up cursor 37700 PENA 8: PENB 8: PENO 8: CURS=CURS-8: BOX(CURS,52;CURS+7,60),1 37800 GOTO 35600 37900 IF C$<>"." AND C$<>"-" GOTO 38500 38000 IF LEN(NAME$)>=17 GOTO 35500 'Ending . or - not allowed 38100 IF RIGHT$(NAME$,1)="." OR RIGHT$(NAME$,1)="-" GOTO 35500 38200 GOTO 38700 38300 IF ASC(C$)=8 GOTO 35600 'Superfluous backspace 38400 IF C$<"A" GOTO 35500 'Test used only for first character 38500 IF C$<"0" OR (C$>"9" AND C$<"A") GOTO 35500 38600 IF (C$>"Z" AND C$<"a") OR C$>"z" GOTO 35500 38700 IF LEN(NAME$)>=18 GOTO 35500 38800 ' Add this letter and advance cursor 38900 NAME$=NAME$+C$ 39000 PENA 2: PENB 2: PENO 2: BOX(CURS,52;CURS+7,60),1 39100 PENA 1: PRINT AT(CURS,59);C$ 39200 PENA 8: PENB 8: PENO 8: CURS=CURS+8: BOX(CURS,52;CURS+7,60),1 39300 GOTO 35600 'Get another character 39400 RETURN 39500 ' 39600 ' Exit - Requires second click (to avoid accidental exit) 39700 PENO 5: BOX(0,170;45,186): PENDING=2 39800 WHILE L%>0: ASK MOUSE X%,Y%,L%: WEND 39900 WHILE L%=0: ASK MOUSE X%,Y%,L%: GOSUB 17400: WEND 40000 ' Be sure he's still in the EXIT box 40100 Y%=Y%-1 'As usual 40200 IF X%>=0 AND X%<46 AND X%<W% AND Y%>169 AND Y%<H% GOTO 48800 40300 ' Decided not to exit after all 40400 PENO 1: BOX(0,170;45,186): PENO COLOR: PENDING=0 40500 RETURN 40600 ' 40700 ' Set color 40800 IF ERASING THEN PENA 1: PRINT AT(3,138);"Erase" 'Reset to black 40900 ERASING=FALSE: IF COLOR=0 GOTO 41400 41000 ' Delete while highlight around previous color 41100 PENO 1: IF COLOR<3 THEN BOX(21,10*(COLOR+10);45,10*(COLOR+11)) 41200 IF COLOR>2 THEN BOX(0,10*(COLOR-3);20,10*(COLOR-2)) 41300 IF COLOR=15 THEN PENO 15: BOX(1,121;19,129) 41400 I=COLOR: COLOR=Y%\10+3: IF X%>21 THEN COLOR=COLOR-13 41500 ' The previous color becomes the PENB color (for pattern) 41600 IF I<>COLOR THEN LASTCOLOR=I: PENB I 41700 ' Add white highlight around the new color 41800 PENO 15: IF COLOR<3 THEN BOX(21,10*(COLOR+10);45,10*(COLOR+11)) 41900 IF COLOR>2 THEN BOX(0,10*(COLOR-3);20,10*(COLOR-2)) 42000 ' Fix up the pattern box to show the current 2 colors 42100 PENA COLOR: IF DOTTY THEN BOX(22,91;44,99),1 42200 ' Add an extra black highlight when color white is selected 42300 IF COLOR=15 THEN PENO 1: BOX(1,121;19,129) 42400 PENO COLOR 42500 RETURN 42600 ' 42700 ' Set style (and brush width, adjusted for resolution) 42800 PENO 1: IF STYLE>0 THEN BOX(21,10*(STYLE-1);45,10*STYLE) 42900 STYLE=Y%\10+1 43000 PENO 15: BOX(21,10*(STYLE-1);45,10*STYLE) 43100 PENA COLOR: PENO COLOR: DY=STYLE-1: DX=2*DY*RES2% 43200 RETURN 43300 ' 43400 ' Set/reset pattern. When pattern is in use, DOTTY=TRUE 43500 IF DOTTY GOTO 43900 43600 DOTTY=TRUE: PATTERN 2,PAT2%: DRAWMODE 1 43700 PENB 0: PENO 15: LASTCOLOR=0: BOX(22,91;44,99),1 43800 GOTO 44100 43900 PENA 2: PENB 0: PENO 0: LASTCOLOR=0: BOX(22,91;44,99),1 44000 DOTTY=FALSE: PATTERN 2,PAT1%: DRAWMODE 0 44100 PENA COLOR: PENO COLOR 44200 RETURN 44300 ' 44400 ' Cycle colors (except black, white and greys). Suppress color 44500 ' boxes, etc. until done. This option can give the effect of 44600 ' movement (as may be noted in the selection box itself) 44700 PENA 2: OUTLINE 0 44800 IF NOT DOTTY GOTO 45100 44900 PATTERN 2,PAT1%: DRAWMODE 0 45000 AREA(23,92 TO 43,92 TO 43,98 TO 23,98) 45100 FOR I=0 TO 120 STEP 10 45200 AREA(1,I+1 TO 19,I+1 TO 19,I+9 TO 1,I+9): NEXT 45300 PENA 0: PENO 2: OUTLINE 1 45400 AREA(26,62 TO 43,63 TO 38,68 TO 26,68) 45500 IF ERASING THEN PENA 1: PRINT AT(3,138);"Erase" 45600 X2%=W%: Y2%=H% 45700 WHILE L%>0: ASK MOUSE X%,Y%,L%: WEND 'Wait for button release 45800 ' Stop on the next click within the window 45900 WHILE L%=0 OR X%<0 OR X%>W% OR Y%<0 OR Y%>H% 46000 FOR I=0 TO 11: X%=COLORS%(I) 46100 RGB (X1%+I)MOD 12+3,X%\1024,(X%\32) MOD 32,X% MOD 32: NEXT 46200 X1%=X1%+1: ASK MOUSE X%,Y%,L%: Y%=Y%-1 46300 ' Check for window resizing. If so turn off color boxes again 46400 GOSUB 17400: IF X2%<>W% OR Y2%<>H% GOTO 44700 46500 WEND 46600 ' We're done. Restore color boxes, etc. 46700 FOR I=0 TO 11: X%=COLORS%(I) 46800 RGB I+3,X%\1024,(X%\32)MOD 32,X% MOD 32: NEXT 46900 OUTLINE 0 47000 FOR I=0 TO 120 STEP 10 47100 PENA I/10+3: AREA(1,I+1 TO 19,I+1 TO 19,I+9 TO 1,I+9): NEXT 47200 IF COLOR=15 THEN PENO 1: BOX(1,121;19,129) 47300 OUTLINE 1: PENA 13: PENO 2: AREA(26,62 TO 43,63 TO 38,68 TO 26,68) 47400 IF ERASING THEN PENA 5: PRINT AT(3,138);"Erase" 47500 PENA COLOR: PENO COLOR 47600 IF NOT DOTTY THEN RETURN 47700 PATTERN 2,PAT2%: DRAWMODE 1 47800 OUTLINE 0: AREA(23,92 TO 43,92 TO 43,98 TO 23,98) 47900 RETURN 48000 ' 48100 ' Error recovery (for disk I/O and file present errors) 48200 ' ERR 53 = No file, ERR 57 = Disk full or I/O error 48300 ' If anything else, abort the run and report the error 48400 IF ERR<>53 AND ERR<>57 GOTO 48800 48500 IF NOFILE THEN RESUME 32000 ELSE RESUME 30300 48600 ' 48700 ' Restore original screen and colors 48800 FOR I=0 TO 15: X%=OLDCOLOR%(I) 48900 RGB I,X%\1024,(X%\32)MOD 32,X% MOD 32: NEXT 49000 CLR: CLOSE #1 49100 IF RES%<>OLDRES% THEN SCREEN OLDRES%\640,4,0 49200 GRAPHIC(0) 49300 ' Report any unexpected error 49400 IF ERR<>0 AND ERR<>53 AND ERR<>57 THEN PRINT ERR$(ERR);ERL 49500 END