home *** CD-ROM | disk | FTP | other *** search
- 10 ' ==========================================================
- 20 ' Color shaper designer, by Tim Holloway, Jacksonville, FL
- 30 ' Allows the design of 16*16 graphics that can be saved
- 40 ' as a file and BLOADED into ABasiC programs
- 50 '
- 60 ' Features: mouse-selectable color registers (0-7)
- 70 ' mouse-controllable sliders to program colors
- 80 ' mouse used to click on colors in 'fatbits' box
- 90 ' HELP KEY!!! (uses windows)
- 100 ' ==========================================================
- 110 DIM PIXEL%(138): ' Define similar array(s) in programs to BLOAD
- 120 ' and GSHAPE the pictures you generate.
- 130 SCNCLR
- 140 RGB 5,8,2,15: ' Initial color
- 150 GOSUB 630
- 160 PRINT AT (1,1) "GRAPHICS EDITOR by Tim Holloway"
- 170 PEN=5:pena 5:PENO 5:GOSUB 900
- 180 for i=0 to 16:draw (i*8+10, 10;i*8+10,16*8+10),1:next
- 190 for i = 0 to 16: draw (10,i*8+10; 10+16*8,i*8+10),1:next
- 200 '
- 210 get a$
- 220 if a$<> "" then 330
- 230 ASK MOUSE X%,Y%,C%
- 240 ' PRINT AT (1,22);X%;Y%:' DEBUGGING
- 250 if c%=0 then 210
- 260 if (X%>39) AND (X%<105) AND (y%>152) and (y%<160) then 410
- 270 IF (X%>217) AND (X%<281) AND (Y%>150) AND (Y%<180) THEN 720
- 280 if (x% < 11) or (x%>137) or (y%<11) or (y%>137) then 210
- 290 x%=int((x%-11)/8)+1:y%=int((y%-11)/8)+1
- 300 draw (150+x%,50+y%)
- 310 box (11+(x%-1)*8,11+(y%-1)*8; 17+(x%-1)*8,17+(y%-1)*8),1
- 320 goto 210
- 330 '
- 340 IF A$ >= "a" AND A$ <= "z" THEN A$=CHR$(ASC(A$)-&H20)
- 350 if asc(a$) = 155 then 470
- 360 ' You can select a register by typing its number
- 370 IF INSTR ("012345678",A$) <> 0 THEN PENA VAL(A$):PENO Val(A$): GOTO 210
- 380 IF A$="S" THEN 550
- 390 IF A$="E" THEN 40:'ERASE
- 400 GOTO 210
- 410 ' select color
- 420 PEN= int((X%-40)/8)
- 430 pena PEN:peno PEN
- 440 GOSUB 900
- 450 goto 180
- 460 '
- 470 ' ANALYZE ESCAPE SEQUENCE
- 480 getkey a$
- 490 getkey b$
- 500 if asc(b$) <> 126 then 490
- 510 if a$ <> "?" then 530
- 520 gosub 820:goto 200
- 530 goto 210
- 540 '
- 550 ' SAVE SHAPE
- 560 SSHAPE (150,50; 166,66),PIXEL%()
- 570 PRINT AT (19,2) "FILENAME=";
- 580 INPUT FI$
- 590 IF FI$="" THEN 610
- 600 BSAVE FI$+".PIC",VARPTR(PIXEL%(0)),138*4
- 610 print at (19,2) " ":goto 210
- 620 '
- 630 ' DRAW COLOR SAMPLE BOXES
- 640 FOR I = 0 TO 7
- 650 PENA I:PENO I:BOX (40+8*I,160; 48+8*I,168),1
- 660 NEXT
- 670 PRINT AT (6,23);"01234567"
- 680 PRINT AT (22,20) "RED";:DRAW (220,154;284,154)
- 690 PRINT AT (22,21) "GREEN";:DRAW (220,162;284,162)
- 700 PRINT AT (22,22) "BLUE";:DRAW (220,170;284,170)
- 710 RETURN
- 720 ' ALTER COLOR REGISTERS
- 730 ASK RGB PEN,RED%,GREEN%,BLUE%
- 740 NEWC%=INT((X%-220)/4)
- 750 IF (Y%>153) AND (Y%<158) THEN RED%=NEWC%:GOTO 790
- 760 IF (Y%>161) AND (Y%<169) THEN GREEN%=NEWC%:GOTO 790
- 770 IF (Y%>171) THEN BLUE%=NEWC%:GOTO 790
- 780 GOTO 210
- 790 RGB PEN,RED%,GREEN%,BLUE%
- 800 GOSUB 900
- 810 GOTO 210
- 820 ' Help
- 830 window #1,148,11,152,150,"HELP"
- 840 cmd #1
- 850 print "E - erase and redraw"
- 860 print "S - Save picture as filename.PIC"
- 870 print "Control-C to quit"
- 880 print "Use mouse on sliders to change colors"
- 890 print:print:pint:print:print "press RETURN to continue":cmd 0:getkey z$:close #1:return
- 900 ' PRINT REGISTER VALUES
- 910 ASK RGB PEN,RED%,GREEN%,BLUE%
- 920 PRINT AT (22,13);"REG ";PEN
- 930 PRINT AT (22,14);"RED";RED%
- 940 PRINT AT (22,15);"GREEN";GREEN%
- 950 PRINT AT (22,16);"BLUE";BLUE%
- 960 PENA 0:DRAW (42,150;42+64,150)
- 970 PENA 15:DRAW (42+8*PEN,150;46+8*PEN,150)
- 980 PENA PEN
- 990 RETURN
-
-