paintmatch: REM "*********************************************" REM "* *" REM "* B-Paint is copyright © 1987,1988 *" REM "* by Eduardo E. Silva. All Rights *" REM "* Reserved. You may not make copies of *" REM "* this program, source code or parts *" REM "* thereof, except as backup copies for *" REM "* use on one and only one machine, *" REM "* without express written permission of *" REM "* the Publisher: *" REM "* *" REM "* Finally Technologies *" REM "* 1377 9th Avenue *" REM "* San Francisco, CA 94122 *" REM "* (415) 564-5903 *" REM "* *" REM "* Many thanks to : *" REM "* *" REM "* Carolyn Scheppener - CATS *" REM "* *" REM "*********************************************" LIBRARY "graphics.library" LIBRARY "dos.library" LIBRARY "exec.library" LIBRARY "intuition.library" LIBRARY "diskfont.library" DECLARE FUNCTION OpenDiskFont&() LIBRARY DECLARE FUNCTION TextLength&() LIBRARY DECLARE FUNCTION xOpen&() LIBRARY DECLARE FUNCTION xRead&() LIBRARY DECLARE FUNCTION xWrite&() LIBRARY DECLARE FUNCTION ViewPortAddress&() LIBRARY DECLARE FUNCTION AllocMem&() LIBRARY DECLARE FUNCTION AllocRaster&() LIBRARY DECLARE FUNCTION AllocSignal%() LIBRARY DECLARE FUNCTION FindTask&() LIBRARY DECLARE FUNCTION DoIO&() LIBRARY DECLARE FUNCTION OpenDevice&() LIBRARY DIM cTabWork%(32), cTabSave%(32) DIM LetterBuffer$(100) DIM UndoBuffers% (100) DIM ColorRed(32),ColorGreen(32),ColorBlue(32),ColorRegister(32) DIM TempRed(32),TempGreen(32),TempBlue(32) DIM sBplane&(5) DIM filla%(7),fillb%(7),fillc%(7),filld%(7),fille%(7),Solid%(7) DIM fillf%(7),fillg%(7),FillH%(7) DIM Bricks%(7),VertLines%(7),Checkers%(7),RightLines%(7) DIM BoxSmall%(7),BoxBig%(7),DenseDots%(7) DIM brush%(27000) DIM oops% (27000) TRUE% = 1 FALSE% = 0 DoBpaint% = TRUE% GOSUB SetUp GOSUB SetEvents main: WHILE ( DoBpaint% ) WHILE ( MOUSE(0) = 0 ) m0% = MOUSE(0) x% = MOUSE(1) y% = MOUSE(2) main03: m0% = MOUSE(0) IF (ABS(x%-MOUSE(1)) = 0 AND ABS(y%-MOUSE(2)) = 0 AND MOUSE(0)=0) GOTO main03 GOSUB DoSmartSubs WEND WEND GOTO ADIOS END CheckMenu: MenuID% = MENU (0) MenuItem% = MENU (1) LeMenuID% = MenuID% LeMenuItem% = MenuItem% ON MenuID% GOSUB m1, m2, m3, m4 RETURN DoSmartSubs: IF ( beraser% = TRUE% ) THEN GOSUB SmartEraser IF ( bpickmybrush% = TRUE% ) THEN GOSUB SmartMyBrush IF ( bmybrush% = TRUE% ) THEN GOSUB SmartMyBrush RETURN DoSub: GOSUB GetXY IF ( MenuRoutine% = TRUE% ) THEN GOTO NoDoSub IF ( bdraw% = TRUE% ) THEN GOSUB Tdraw IF ( bline% = TRUE% ) THEN GOSUB Tline IF ( brect% = TRUE% ) THEN GOSUB Trect IF ( bellipse% = TRUE% ) THEN GOSUB Tellipse IF ( bbox% = TRUE% ) THEN GOSUB Tbox IF ( bdisk% = TRUE% ) THEN GOSUB Tdisk IF ( bpaint% = TRUE% ) THEN GOSUB Tpaint IF ( beraser% = TRUE% ) THEN GOSUB Teraser IF ( bpickmybrush% = TRUE% ) THEN GOSUB TPickMyBrush IF ( bmatch% = TRUE% ) THEN GOSUB Tmatch IF ( bpatternfill% = TRUE% ) THEN GOSUB Tpatternfill IF ( bair% = TRUE% ) THEN GOSUB Tair IF ( bboxpattern% = TRUE% ) THEN GOSUB Tboxpattern IF ( bmybrush% = TRUE% ) THEN GOSUB MyBrush IF ( btext% = TRUE% ) THEN GOSUB Ttext NoDoSub: RETURN m1: ON MenuItem% GOSUB m11, m12, m13, m14, m15, m16, m17, m18 RETURN m2: ON MenuItem% GOSUB m21, m22, m23, m24, m25, m26, m27, m28 RETURN m3: ON MenuItem% GOSUB m31, m32, m33, m34 RETURN m4: ON MenuItem% GOSUB m41, m42, m43, m44, m45, m46, m47 RETURN REM ******************** REM * * REM * Menu 1 items * REM * * REM ******************** m11: MenuRoutine% = TRUE% GOSUB Pnew MenuRoutine% = FALSE% RETURN m12: MenuRoutine% = TRUE% GOSUB Pload MenuRoutine% = FALSE% RETURN m13: MenuRoutine% = TRUE% GOSUB Psave MenuRoutine% = FALSE% RETURN m14: MenuRoutine% = TRUE% GOSUB Psaveas MenuRoutine% = FALSE% RETURN m15: MenuRoutine% = TRUE% GOSUB Pprint MenuRoutine% = FALSE% RETURN m16: GOSUB Pclear RETURN m17: GOSUB RefreshDisplay RETURN m18: MenuRoutine% = TRUE% GOSUB Pquit MenuRoutine% = FALSE% RETURN REM ******************** REM * * REM * Menu 2 items * REM * * REM ******************** m21: GOSUB FalseFlag bdraw% = TRUE% lmsg$="FreeHand Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m22: GOSUB FalseFlag bline% = TRUE% lmsg$="Line Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m23: GOSUB FalseFlag brect% = TRUE% lmsg$ = "Empty Box Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m24: GOSUB FalseFlag bellipse% = TRUE% lmsg$="Empty Oval Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m25: GOSUB FalseFlag bbox% = TRUE% lmsg$="Solid Box Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m26: GOSUB FalseFlag bdisk% = TRUE% lmsg$="Solid Disk Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m27: GOSUB FalseFlag bpaint% = TRUE% lmsg$="Paint Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m28: GOSUB FalseFlag beraser% = TRUE% lmsg$="Eraser Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN REM ******************** REM * * REM * Menu 3 items * REM * * REM ******************** m31: MenuRoutine% = TRUE% GOSUB Tselect MenuRoutine% = FALSE% RETURN m32: MenuRoutine% = TRUE% GOSUB Tpattern MenuRoutine% = FALSE% RETURN m33: MenuRoutine% = TRUE% GOSUB Tfonts MenuRoutine% = FALSE% RETURN m34: GOSUB FalseFlag bpickmybrush% = TRUE% lmsg$="PickBrush Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN REM ******************** REM * * REM * Menu 4 items * REM * * REM ******************** m41: MenuRoutine% = TRUE% DoMix% = TRUE% GOSUB Tmix DoMix% = FALSE% MenuRoutine% = FALSE% RETURN m42: GOSUB FalseFlag bmatch% = TRUE% lmsg$="Match Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m43: GOSUB FalseFlag bpatternfill% = TRUE% lmsg$="PatternFill Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m44: GOSUB FalseFlag bair% = TRUE% lmsg$="AirBrush Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m45: GOSUB FalseFlag bboxpattern% = TRUE% lmsg$="BoxPattern Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m46: GOSUB FalseFlag bmybrush% = TRUE% lmsg$="MyBrush Mode" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) RETURN m47: GOSUB FalseFlag btext% = TRUE% GOSUB Ttext RETURN REM ********************************** REM * * REM * PROJECT menu items * REM * * REM ********************************** REM ***************** REM * * REM * Pnew * REM * * REM ***************** Pnew: WINDOW 4,"New Mode",(0,0)-(311,30),0,1 WINDOW OUTPUT 4 MOUSE OFF dir$ = " " n$ = " " ILBMname$ = " " PRINT PRINT "One Second" GOSUB MenuOff pnew1: CLS GOSUB Tbeep PRINT INPUT "Picture name : ",ILBMname$ CLS IF ILBMname$ = "exit" GOTO newl IF n$ = "exit" GOTO newl IF dir$ = "exit" GOTO newl IF ILBMname$ = "" GOTO pnew1 newl: MOUSE ON m0% = MOUSE(0) FOR x% = 0 TO 3000:NEXT x% GOSUB Tbeep WINDOW CLOSE 4 MOUSE ON GOSUB MenuOn WINDOW OUTPUT 2 newout: RETURN REM ******************* REM * * REM * Pload * REM * * REM ******************* Pload: WINDOW 4,"LoadMode",(0,0)-(311,30),0,1 WINDOW OUTPUT 4 PRINT PRINT "One Second" GOSUB MenuOff MOUSE OFF GetNames: CLS INPUT "Picture name : ",ILBMname$ CLS IF ILBMname$ = "exit" GOTO loadl IF ILBMname$ = "" GOTO GetNames CLS loadok: WINDOW OUTPUT 2 WINDOW CLOSE 4 lmsg$="Loading Picture..." CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) LoadError$ = "" Logo: GOSUB LoadILBM IF LoadError$ <> "" THEN GOTO Mcleanup GOTO ploadl Mcleanup: GOTO ploadl Mcleanup2: IF LoadError$ <> "" GOTO lcleanup GOTO ploadl LoadILBM: f$ = ILBMname$ fHandle& = FALSE% mybuf& = FALSE% foundBMHD = FALSE% foundCMAP = FALSE% foundCAMG = FALSE% foundCCRT = FALSE% foundBODY = FALSE% filename$ = f$ + CHR$(0) fHandle& = xOpen&(SADD(filename$),1005) IF fHandle& = FALSE% THEN LoadError$ = "Can't open/find pic file" GOTO lcleanup END IF ClearPublic& = 65537& mybufsize& = 360 mybuf& = AllocMem&(mybufsize&,ClearPublic&) IF mybuf& = 0 THEN LoadError$ = "Can't alloc buffer" GOTO lcleanup END IF inbuf& = mybuf& cbuf& = mybuf& + 120 ctab& = mybuf& + 240 rLen& = xRead&(fHandle&,inbuf&,12) tt$ = "" FOR kk = 8 TO 11 tt% = PEEK(inbuf& + kk) tt$ = tt$ + CHR$(tt%) NEXT IF tt$ <> "ILBM" THEN LoadError$ = "Not standard ILBM pic file" GOTO lcleanup END IF ChunkLoop: REM - Get Chunk name/length rLen& = xRead&(fHandle&,inbuf&,8) icLen& = PEEKL(inbuf& + 4) tt$ = "" FOR kk = 0 TO 3 tt% = PEEK(inbuf& + kk) tt$ = tt$ + CHR$(tt%) NEXT IF tt$ = "BMHD" THEN foundBMHD = TRUE% rLen& = xRead&(fHandle&,inbuf&,icLen&) iWidth% = PEEKW(inbuf&) iHeight% = PEEKW(inbuf& + 2) iDepth% = PEEK(inbuf& + 8) iCompr% = PEEK(inbuf& + 10) scrWidth% = PEEKW(inbuf& + 16) scrHeight% = PEEKW(inbuf& + 18) iRowBytes% = iWidth% /8 scrRowBytes% = scrWidth% / 8 nColors% = 2^(iDepth%) kk = TRUE% IF nColors%<>32 THEN LoadError$ = " ---- Wrong format ---" GOTO lcleanup END IF REM ************************************** REM * * REM * PAL NTSC PAL NTSC PAL NTSC PAL * REM * * REM * Many thanks to : * REM * * REM * Carolyn Scheppener - CATS * REM * * REM ************************************** hires&=&H800 lace&=&H4 kk=1 IF ( foundCamg ) THEN IF ( camgModes& AND hires& ) THEN kk = kk + 1 IF ( camgModes& AND lace& ) THEN kk = kk + 2 ELSE IF scrWidth% > 320 THEN kk = kk + 1 IF scrHeight% > 256 THEN kk = kk + 2 END IF GOSUB WindowStruct ELSEIF tt$ = "CMAP" THEN foundCMAP = 1 rLen& = xRead&(fHandle&,cbuf&,icLen&) ColorMap: counter% = 0 REM - Build Color Table FOR kk = 0 TO nColors% - 1 red% = PEEK(cbuf&+(kk*3)) gre% = PEEK(cbuf&+(kk*3)+1) blu% = PEEK(cbuf&+(kk*3)+2) cred = (red%/16)/16 cgre = (gre%/16)/16 cblu = (blu%/16)/16 ColorRed ( counter% ) = cred ColorGreen ( counter% ) = cgre ColorBlue ( counter% ) = cblu TempRed ( counter% ) = ColorRed ( counter% ) TempGreen ( counter% ) = ColorGreen ( counter% ) TempBlue ( counter% ) = ColorBlue ( counter% ) PALETTE counter%,TempRed ( counter% ),TempGreen ( counter% ),TempBlue ( counter% ) regTemp% = (red%*16)+(gre%)+(blu%/16) POKEW(ctab&+(2*kk)),regTemp% counter% = counter% + 1 NEXT IF foundCMAP THEN CALL LoadRGB4&(sViewPort&,ctab&,nColors%) END IF ELSEIF tt$ = "CAMG" THEN foundCAMG = 1 rLen& = xRead&(fHandle&,inbuf&,icLen&) camgModes& = PEEKL(inbuf&) ELSEIF tt$ = "BODY" THEN foundBODY = 1 IF iCompr% = 0 THEN FOR rr% = 0 TO iHeight% -1 FOR pp% = 0 TO iDepth% -1 scrRow& = bPlane&(pp%)+(rr%*scrRowBytes%) rLen& = xRead&(fHandle&,scrRow&,iRowBytes%) NEXT NEXT ELSEIF iCompr% = 1 THEN FOR rr% = 0 TO iHeight% -1 FOR pp% = 0 TO iDepth% -1 scrRow& = bPlane&(pp%)+(rr%*scrRowBytes%) bCnt% = 0 WHILE (bCnt% < iRowBytes%) rLen& = xRead&(fHandle&,inbuf&,1) inCode% = PEEK(inbuf&) IF inCode% < 128 THEN rLen& = xRead&(fHandle&,scrRow& + bCnt%, inCode%+1) bCnt% = bCnt% + inCode% + 1 ELSEIF inCode% > 128 THEN rLen& = xRead&(fHandle&,inbuf&,1) inByte% = PEEK(inbuf&) FOR kk% = bCnt% TO bCnt% + 257 - inCode% POKE(scrRow&+kk%),inByte% NEXT bCnt% = bCnt% + 257 - inCode% END IF WEND NEXT NEXT ELSE LoadError$ = "Unknown compression algorithm" GOTO lcleanup END IF ELSE FOR kk = 1 TO icLen& rLen& = xRead&(fHandle&,inbuf&,1) NEXT IF (icLen& OR 1) = icLen& THEN rLen& = xRead&(fHandle&,inbuf&,1) END IF END IF IF foundBMHD AND foundCMAP AND foundBODY THEN GOTO GoodLoad END IF IF rLen& > 0 THEN GOTO ChunkLoop IF rLen& < 0 THEN LoadError$ = "Read error" GOTO lcleanup END IF REM - rLen& = 0 means EOF IF (foundBMHD = 0) OR (foundBODY = 0) OR (foundCMAP = 0) THEN LoadError$ = "Needed ILBM chunks not found" GOTO lcleanup END IF GoodLoad: LoadError$ = "" IF foundCMAP THEN CALL LoadRGB4&(sViewPort&,ctab&,nColors%) END IF lcleanup: WINDOW 4,"Error message...!",(0,0)-(310,30),0,1 WINDOW OUTPUT 4 loadl: PRINT LoadError$ MOUSE ON FOR x% = 0 TO 3000:NEXT x% IF fHandle& <> 0 THEN CALL xClose&(fHandle&) IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&) GOSUB Tbeep WINDOW CLOSE 4:MOUSE ON GOSUB MenuOn WINDOW OUTPUT 2 RETURN IF fHandle& <> 0 THEN CALL xClose&(fHandle&) IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&) ploadl: MOUSE ON MENU ON RETURN REM ******************* REM * * REM * Psave * REM * * REM ******************* Psave: IF (ILBMname$ = "" OR ILBMname$ = "Untitled" ) THEN GOSUB Psaveas IF (ILBMname$ <> "") THEN GOSUB SaveILBM RETURN REM ******************* REM * * REM * Psaveas * REM * * REM ******************* Psaveas: WINDOW 4,"Save Mode",(0,0)-(311,30),0,1 WINDOW OUTPUT 4 MOUSE OFF dir$ = " " n$ = " " PRINT PRINT "One Second" GOSUB MenuOff psave1: CLS GOSUB Tbeep INPUT "Picture name : ",ILBMname$ CLS IF ILBMname$ = "exit" GOTO savel IF ILBMname$ = "" GOTO psave1 psaveok: WINDOW OUTPUT 2 WINDOW CLOSE 4 SaveILBM: CALL SetWindowTitles&(WINDOW(7),-1,SADD(ILBMname$+CHR$(0)) ) IF (ILBMname$<>"") THEN saveError$ = "" END IF filename$ = ILBMname$+CHR$(0) fHandle& = 0 mybuf& = 0 fHandle& = xOpen&(SADD(filename$),1006) IF fHandle& = 0 THEN saveError$ = "Can't open "+ILBMname$ GOTO psavel END IF ClearPublic& = 65537& mybufsize& = 120 mybuf& = AllocMem& (mybufsize&,ClearPublic&) IF mybuf& = 0 THEN saveError$ = "cant allocate buffer" GOTO psavel END IF cbuf& = mybuf& GOSUB WindowStruct zero& = 0 pad% = 0 aspect% = &HA0B BMHDsize& = 20 CMAPsize& = (2^scrDepth%)*3 CAMGsize& = 4 CCRTsize& = 14 BODYsize& = (scrWidth%/8)*scrHeight%*scrDepth% FORMsize& = BMHDsize&+CMAPsize&+CAMGsize&+CCRTsize&+BODYsize&+44 tt$ = "FORM" wLen& = xWrite&(fHandle&,SADD(tt$),4) wLen& = xWrite&(fHandle&,VARPTR(FORMsize&),4) tt$ = "ILBM" wLen& = xWrite&(fHandle&,SADD(tt$),4) IF wLen&< = 0 THEN saveError$ = "Error writing FORM header" GOTO psavel END IF tt$ = "BMHD" wLen& = xWrite&(fHandle&,SADD(tt$),4) wLen& = xWrite&(fHandle&,VARPTR(BMHDsize&),4) wLen& = xWrite&(fHandle&,VARPTR(scrWidth%),2) wLen& = xWrite&(fHandle&,VARPTR(scrHeight%),2) wLen& = xWrite&(fHandle&,VARPTR(zero&),4) temp% = (256*scrDepth%) wLen& = xWrite&(fHandle&,VARPTR(temp%),2) wLen& = xWrite&(fHandle&,VARPTR(zero&),4) wLen& = xWrite&(fHandle&,VARPTR(aspect%),2) wLen& = xWrite&(fHandle&,VARPTR(scrWidth%),2) wLen& = xWrite&(fHandle&,VARPTR(scrHeight%),2) IF wLen&< = 0 THEN saveError$ = "Error while writing BMHD" GOTO psavel END IF tt$ = "CMAP" wLen& = xWrite&(fHandle&,SADD(tt$),4) wLen& = xWrite&(fHandle&,VARPTR(CMAPsize&),4) FOR kk = 0 TO nColors%-1 regTemp% = PEEKW(colorTab&+(2*kk)) POKE(cbuf&+(kk*3)),(regTemp% AND &HF00)/16 POKE(cbuf&+(kk*3)+1),(regTemp% AND &HF0) POKE(cbuf&+(kk*3)+2),(regTemp% AND &HF)*16 NEXT kk wLen& = xWrite&(fHandle&,cbuf&,CMAPsize&) IF wLen&< = 0 THEN saveError$ = "Error writing CMAP" GOTO psavel END IF tt$ = "CAMG" wLen& = xWrite&(fHandle&,SADD(tt$),4) wLen& = xWrite&(fHandle&,VARPTR(CAMGsize&),4) vpModes& = PEEKW(sViewPort&+32) wLen& = xWrite&(fHandle&,VARPTR(vpModes&),4) IF wLen&< = 0 THEN saveError$ = "Error writing CAMG" GOTO psavel END IF ccrtDir% = 1 ccrtStart% = 1 ccrtEnd% = nColors% - 1 ccrtSecs& = 0 ccrtMics& = 2000 REM - Write CCRT chunk tt$ = "CCRT" wLen& = xWrite&(fHandle&,SADD(tt$),4) wLen& = xWrite&(fHandle&,VARPTR(CCRTsize&),4) wLen& = xWrite&(fHandle&,VARPTR(ccrtDir%),2) temp% = (256*ccrtStart%) + ccrtEnd% wLen& = xWrite&(fHandle&,VARPTR(temp%),2) wLen& = xWrite&(fHandle&,VARPTR(ccrtSecs&),4) wLen& = xWrite&(fHandle&,VARPTR(ccrtMics&),4) wLen& = xWrite&(fHandle&,VARPTR(pad%),2) IF wLen& < = 0 THEN saveError$ = "Error writing CCRT" GOTO psavel END IF tt$ = "BODY" wLen& = xWrite&(fHandle&,SADD(tt$),4) wLen& = xWrite&(fHandle&,VARPTR(BODYsize&),4) scrRowBytes% = scrWidth%/8 FOR rr% = 0 TO scrHeight%-1 FOR pp% = 0 TO scrDepth%-1 scrRow& = bPlane&(pp%)+(rr%*scrRowBytes%) wLen& = xWrite&(fHandle&,scrRow&,scrRowBytes%) IF wLen&< = 0 THEN saveError$ = "Error writing BODY" GOTO psavel END IF NEXT pp% NEXT rr% psavel: WINDOW 4,"Error message...!",(0,0)-(310,30),0,1 WINDOW OUTPUT 4 savel: PRINT saveError$ MOUSE ON m0% = MOUSE(0) FOR x% = 0 TO 3000:NEXT x% IF fHandle&<>0 THEN CALL xClose&(fHandle&) IF mybuf&<>0 THEN CALL FreeMem&(mybuf&,mybufsize&) GOSUB Tbeep REM * Pprint * MOUSE ON GOSUB MenuOn WINDOW OUTPUT 2 GOSUB SetEvents RETURN REM ************************ REM * * REM * Pprint * REM * * REM ************************ Pprint: GOSUB WindowStruct maxWidth% = PEEKW(sScreen& + 12) maxHeight% = PEEKW(sScreen& + 14) viewModes% = PEEKW(sViewPort& + 32) command% = 11 srcX% = 0 srcY% = 0 srcWidth% = maxWidth% srcHeight% = maxHeight% destRows& = 0 destCols& = 0 SPECIAL% = &H84 IF BorderFlag% = 0 THEN srcX% = srcX% + 3 srcY% = srcY% + 11 srcWidth% = srcWidth% - 3 - 11 srcHeight% = srcHeight% - 11 - 3 END IF sigBit% = AllocSignal%(-1) ClearPublic& = 65537& msgPort& = AllocMem&(40,ClearPublic&) IF msgPort& = 0 THEN PrintError$ = " Can't allocate msgPort " GOTO cleanup1 END IF POKE(msgPort& + 8), 4 POKE(msgPort& + 9), 0 portName$ = "MyPrtPort"+CHR$(0) POKEL(msgPort& + 10), SADD(portName$) POKE(msgPort& + 14), 0 POKE(msgPort& + 15), sigBit% sigTask& = FindTask&(0) POKEL(msgPort& + 16), sigTask& CALL AddPort(msgPort&) ioRequest& = AllocMem&(64,ClearPublic&) IF ioRequest& = 0 THEN PrintError$ = " Can't allocate ioRequest" GOTO cleanup1 END IF POKE(ioRequest& + 8),5 POKE(ioRequest& + 9),0 POKEL(ioRequest& + 14), msgPort& devName$ = "printer.device"+CHR$(0) pError& = OpenDevice&(SADD(devName$),0,ioRequest&,0) IF pError& <> 0 THEN PrintError$ = " ====== Can't open printer ====== " GOTO cleanup1 END IF POKEW(ioRequest& + 28), command% POKEL(ioRequest& + 32),sRastPort& POKEL(ioRequest& + 36),sColorMap& POKEL(ioRequest& + 40), viewModes% POKEW(ioRequest& + 44), srcX% POKEW(ioRequest& + 46), srcY% POKEW(ioRequest& + 48), srcWidth% POKEW(ioRequest& + 50), srcHeight% POKEL(ioRequest& + 52), destCols& POKEL(ioRequest& + 56), destRows& POKEW(ioRequest& + 60), SPECIAL% ioError& = DoIO&(ioRequest&) IF ioError& <> 0 THEN PrintError$ = "DumpRPort error " GOTO cleanup1 END IF cleanup1: CALL CloseDevice(ioRequest&) REM cleanup2: POKE(ioRequest& + 8), &HFF POKEL(ioRequest& + 20), &HFFFF POKEL(ioRequest& + 24), &HFFFF CALL FreeMem(ioRequest&,64) REM cleanup3: CALL RemPort(msgPort&) POKE(msgPort& + 8), &HFF POKEL(msgPort& + 20), &HFFFF CALL FreeSignal(sigBit%) CALL FreeMem(msgPort&,40) PrintError: WINDOW 3,"Error message...!",(0,0)-(310,30),4,1 WINDOW OUTPUT 3 printl: PRINT PrintError$ MOUSE ON m0% = MOUSE(0) PRINT "Press Mouse left Button..." WHILE MOUSE(0) = 0:WEND FOR x% = 0 TO 3000:NEXT x% GOSUB Tbeep WINDOW CLOSE 3 MOUSE ON MENU ON WINDOW OUTPUT 2 RETURN REM ************************ REM * * REM * Pclear * REM * * REM ************************ Pclear: CLS RETURN REM ************************ REM * * REM * Tundo * REM * * REM ************************ Tundo: GOSUB RefreshDisplay RETURN REM ************************ REM * * REM * Pquit * REM * * REM ************************ Pquit: GOSUB DummyWork WINDOW 3,"Requester",(0,0)-(160,50),0,1 WINDOW OUTPUT 3 Pquit3: CLS PRINT" " PRINT" SAVE your work" LINE (20,30)-(60,45),1,b LINE (22,32)-(58,43),1,b LINE (100,30)-(140,45),1,b LINE (102,32)-(138,43),1,b CALL Move& (WINDOW(8),25,40) m$="YES!" CALL Text& (WINDOW(8),SADD(m$+CHR$(0)),4) CALL Move& (WINDOW(8),113,40) m$="No" CALL Text& (WINDOW(8),SADD(m$+CHR$(0)),2) FOR Led% = 0 TO 100 m0% = MOUSE(0) NEXT Led% WHILE ( MOUSE(0) = 0 ) m0%=MOUSE(0) WEND m0%=MOUSE(0) GOSUB GetXY IF ( (x%>20 AND x%<60) AND (y%<45 AND y%>30) ) GOTO SaveIt IF ( (x%>100 AND x%<140) AND (y%<45 AND y%>30) ) GOTO AskAgain SOUND 440,4,255,0 GOTO Pquit3 SaveIt: WINDOW CLOSE 3 GOSUB Psave GOTO ADIOS RETURN AskAgain: ADIOS: DoBpaint% = FALSE% MENU RESET FOR x% = 1 TO 10 WINDOW CLOSE x% NEXT x% SCREEN CLOSE 1 SOUND 440,4,255,0 LIBRARY CLOSE SYSTEM END REM ***************************************** REM * * REM * SHAPE menu items * REM * * REM ***************************************** REM ********************** REM * * REM * Tdraw * REM * * REM ********************** Tdraw: GOSUB SaveDisplay m0% = MOUSE(0) GOSUB GetXY PATTERN ,Solid% IF x%<0 THEN x% = 0 END IF IF y%<0 THEN y% = 0 END IF IF x%>319 THEN x% = 319 END IF IF y%>255 THEN y% = 255 END IF TempColor% = POINT (x%,y%) PSET (x%,y%),TempColor% Tdraw2: WHILE ( MOUSE(0) <> 0 ) GOSUB GetXY LINE -(x%,y%),clrdraw% WEND RETURN REM ********************** REM * * REM * Tline * REM * * REM ********************** Tline: GOSUB SaveDisplay GOSUB Tbeep m0% = MOUSE(0) LineStartX% = MOUSE(1) LineStartY% = MOUSE(2) PATTERN ,Solid% WHILE ( MOUSE(0) <> 0 ) GOSUB GetXY GOSUB MyLine tline3: m0% = MOUSE(0) IF ABS(x%-MOUSE(1)) = 0 AND ABS(y%-MOUSE(2)) = 0 AND MOUSE(0)<>0 GOTO tline3 GOSUB RefreshDisplay WEND GOSUB RefreshDisplay GOSUB GetXY GOSUB MyLine GOSUB Tbeep RETURN REM ********************** REM * * REM * Trect * REM * * REM ********************** Trect: GOSUB SaveDisplay GOSUB Tbeep m0% = MOUSE(0) GOSUB GetXY xi% = MOUSE(3) yi% = MOUSE(4) xf% = MOUSE(5) yf% = MOUSE(6) PATTERN ,Solid% WHILE ( MOUSE (0) <> 0 ) GOSUB GetXY LINE (xi%,yi%)-(x%,y%),clrdraw%,b trect3: m0% = MOUSE(0) IF ABS(x%-MOUSE(1)) = 0 AND ABS(y%-MOUSE(2)) = 0 AND MOUSE(0)<>0 GOTO trect3 GOSUB RefreshDisplay WEND xi% = MOUSE(3) yi% = MOUSE(4) xf% = MOUSE(5) yf% = MOUSE(6) GOSUB RefreshDisplay LINE (xi%,yi%)-(xf%,yf%),clrdraw%,b RETURN REM ********************** REM * * REM * Tellipse * REM * * REM ********************** Tellipse: GOSUB SaveDisplay GOSUB Tbeep m0% = MOUSE(0) centerX% = MOUSE(1) centerY% = MOUSE(2) PATTERN ,Solid% GOSUB Tbeep c% = clrdraw% CALL SetAPen& ( WINDOW(8), c% ) WHILE ( MOUSE (0) <> 0 ) GOSUB GetXY rx% = ABS ( centerX% - x% ) ry% = ABS ( centerY% - y% ) radius% = SQR ( ( rx% * rx% ) + ( ry% * ry% ) ) IF ( radius% < 1) THEN radius% = 1 CALL DrawEllipse& ( WINDOW(8), centerX%, centerY%, radius% ,radius%) tcircle3: m0% = MOUSE(0) IF ABS(x%-MOUSE(1)) = 0 AND ABS(y%-MOUSE(2)) = 0 AND MOUSE(0)<>0 GOTO tcircle3 GOSUB RefreshDisplay WEND GOSUB RefreshDisplay CALL DrawEllipse& ( WINDOW(8), centerX%, centerY%, radius%, radius% ) RETURN REM ********************** REM * * REM * Tbox * REM * * REM ********************** Tbox: GOSUB SaveDisplay GOSUB Tbeep m0% = MOUSE(0) xi% = MOUSE(3) yi% = MOUSE(4) xf% = MOUSE(5) yf% = MOUSE(6) PATTERN ,Solid% WHILE ( MOUSE (0) <> 0 ) GOSUB GetXY LINE (xi%,yi%)-(x%,y%),clrdraw%,bf tbox3: m0% = MOUSE(0) IF ABS(x%-MOUSE(1)) = 0 AND ABS(y%-MOUSE(2)) = 0 AND MOUSE(0)<>0 GOTO tbox3 GOSUB RefreshDisplay WEND xi% = MOUSE(3) yi% = MOUSE(4) xf% = MOUSE(5) yf% = MOUSE(6) GOSUB RefreshDisplay LINE (xi%,yi%)-(xf%,yf%),clrdraw%,bf RETURN REM ********************** REM * * REM * Tdisk * REM * * REM ********************** Tdisk: GOSUB SaveDisplay GOSUB Tbeep m0% = MOUSE(0) centerX% = MOUSE(1) centerY% = MOUSE(2) GOSUB Tbeep c% = clrdraw% CALL SetAPen& (WINDOW(8),c%) PATTERN ,Solid% WHILE ( MOUSE (0) <> 0 ) GOSUB GetXY rx% = ABS(centerX%-x%) ry% = ABS(centerY%-y%) GOSUB DoCircle tdisk3: m0% = MOUSE(0) IF ABS(x%-MOUSE(1)) = 0 AND ABS(y%-MOUSE(2)) = 0 AND MOUSE(0)<>0 GOTO tdisk3 GOSUB RefreshDisplay WEND GOSUB RefreshDisplay GOSUB DoCircle RETURN REM ********************** REM * * REM * DoCircle * REM * * REM ********************** DoCircle: radius% = SQR ( ( rx% * rx% ) + ( ry% * ry% ) ) IF (radius% < 1) THEN radius% = 1 mystep = ( 1 / (radius%) ) limit = ( 3.141592654#/2 ) FOR angle=0 TO limit STEP mystep radiusx = radius% * COS(angle) radiusy = radius% * SIN(angle) circlex1% = (centerX% + radiusx) circley1% = (centerY% - radiusy) circlex2% = (centerX% - radiusx) circley2% = circley1% circlex4% = circlex1% circley4% = (centerY% + radiusy) circlex3% = circlex2% circley3% = circley4% LINE (centerX% ,circley1%)-(circlex1%,circley1%),clrdraw% LINE (centerX%-1,circley2%)-(circlex2%,circley2%),clrdraw% LINE (centerX% ,circley3%)-(circlex3%,circley3%),clrdraw% LINE (centerX%-1,circley4%)-(circlex4%,circley4%),clrdraw% NEXT angle RETURN REM ********************** REM * * REM * Tpaint * REM * * REM ********************** Tpaint: GOSUB SaveDisplay Tpaint1: PATTERN &HFFFF,Solid% IF MOUSE (0) = 0 GOTO Tpaint1 GOSUB Tbeep WHILE MOUSE(0) <> 0 WEND GOSUB GetXY COLOR clrdraw% CALL Flood&(WINDOW(8),1,x%,y%) GOSUB Tbeep RETURN REM ********************** REM * * REM * Teraser * REM * * REM ********************** Teraser: GOSUB SaveDisplay teraser1: WHILE MOUSE (0) = 0 GOSUB GetXY x1% = x%-5 x2% = x%+5 y1% = y%-5 y2% = y%+5 LINE (x1%,y1%)-(x2%,y2%),clrdraw%,bf teraser2: m0% = MOUSE(0) IF ABS(x%-MOUSE(1)) = 0 AND ABS(y%-MOUSE(2)) = 0 AND MOUSE(0)<>0 GOTO teraser2 GOSUB RefreshDisplay LINE (x1%,y1%)-(x2%,y2%),clrdraw%,bf WEND WHILE MOUSE (0) <> 0 GOSUB GetXY x1% = x%-5 x2% = x%+5 y1% = y%-5 y2% = y%+5 LINE (x1%,y1%)-(x2%,y2%),0,bf WEND RETURN REM ************************************* REM * * REM * SELECT menu * REM * * REM ************************************* REM ********************** REM * * REM * Tselect * REM * * REM ********************** Tselect: MENU OFF WINDOW 6,"Palette",(0,0)-(320-10,200-180),0,1 WINDOW OUTPUT 6 Low1: c = 0:s = 10 FOR p = 0 TO 300 STEP s LINE (p,0)-(p+10,20),c,bf c = c+1 IF c>31 THEN c = 31 NEXT p WHILE ( MOUSE(0) = 0 ) GOSUB GetXY WEND GOSUB Tbeep clrdraw% = x%/s q = x%/s IF clrdraw% >31 THEN clrdraw% = 31 IF clrdraw% <0 THEN clrdraw% = 0 c% = clrdraw% CALL SetAPen& ( WINDOW(8), c% ) WINDOW CLOSE 6 WINDOW OUTPUT 2 MENU ON MOUSE ON RETURN REM ********************** REM * * REM * Tpattern * REM * * REM ********************** Tpattern: WINDOW 6,"To select click LEFT mouse button",(0,0)-(310,60),0,1 WINDOW OUTPUT 6 GOSUB MenuOff Plow1: PATTERN &HFFFF,Bricks% LINE (0,0)-(42,25),1,bf LINE (0,0)-(42,25),1,b PATTERN &HFFFF,VertLines% LINE (42,0)-(84,25),1,bf LINE (42,0)-(84,25),1,b PATTERN &HFFFF,Checkers% LINE (84,0)-(126,25),1,bf LINE (84,0)-(126,25),1,b PATTERN &HFFFF,RightLines% LINE (126,0)-(168,25),1,bf LINE (126,0)-(168,25),1,b PATTERN &HFFFF,BoxSmall% LINE (168,0)-(210,25),1,bf LINE (168,0)-(210,25),1,b PATTERN &HFFFF,BoxBig% LINE (210,0)-(252,25),1,bf LINE (210,0)-(252,25),1,b PATTERN &HFFFF,DenseDots% LINE (252,0)-(294,25),1,bf LINE (252,0)-(294,25),1,b PATTERN &HFFFF,filla% LINE (0,25)-(42,50),1,bf LINE (0,25)-(42,50),1,b PATTERN &HFFFF,fillb% LINE (42,25)-(84,50),1,bf LINE (42,25)-(84,50),1,b PATTERN &HFFFF,fillc% LINE (84,25)-(126,50),1,bf LINE (84,25)-(126,50),1 ,b PATTERN &HFFFF,filld% LINE (126,25)-(168,50),1,bf LINE (126,25)-(168,50),1,b PATTERN &HFFFF,fille% LINE (168,25)-(210,50),1,bf LINE (168,0)-(210,50),1,b PATTERN &HFFFF,fillf% LINE (210,25)-(252,50),1,bf LINE (210,25)-(252,50),1,b PATTERN &HFFFF,fillg% LINE (252,25)-(294,50),1,bf LINE (252,25)-(294,50),1,b WHILE MOUSE(0) = 0 GOSUB GetXY WEND IF (x%<41 AND y%<25) THEN MyPattern% = 1 IF (x%>42 AND x%<84) AND (y%<25) THEN MyPattern% = 2 IF (x%>84 AND x%<126) AND (y%<25) THEN MyPattern% = 3 IF (x%>126 AND x%<168) AND (y%<25) THEN MyPattern% = 4 IF (x%>168 AND x%<210) AND (y%<25) THEN MyPattern% = 5 IF (x%>210 AND x%<252) AND (y%<25) THEN MyPattern% = 6 IF (x%>252 AND x%<294) AND (y%<25) THEN MyPattern% = 7 IF (x%<41 AND y%>25) THEN MyPattern% = 8 IF (x%>42 AND x%<84) AND (y%>25) THEN MyPattern% = 9 IF (x%>84 AND x%<126) AND (y%>25) THEN MyPattern% = 10 IF (x%>126 AND x%<168) AND (y%>25) THEN MyPattern% = 11 IF (x%>168 AND x%<210) AND (y%>25) THEN MyPattern% = 12 IF (x%>210 AND x%<252) AND (y%>25) THEN MyPattern% = 13 IF (x%>252 AND x%<294) AND (y%>25) THEN MyPattern% = 14 GOSUB SelectMyPattern WINDOW OUTPUT 2 WINDOW CLOSE 6 GOSUB MenuOn RETURN SelectMyPattern: IF ( MyPattern% = 1 ) THEN PATTERN &HFFFF,Bricks% END IF IF ( MyPattern% = 2 ) THEN PATTERN &HFFFF,VertLines% END IF IF ( MyPattern% = 3 ) THEN PATTERN &HFFFF,Checkers% END IF IF ( MyPattern% = 4 ) THEN PATTERN &HFFFF,RightLines% END IF IF ( MyPattern% = 5 ) THEN PATTERN &HFFFF,BoxSmall% END IF IF ( MyPattern% = 6 ) THEN PATTERN &HFFFF,BoxBig% END IF IF ( MyPattern% = 7 ) THEN PATTERN &HFFFF,DenseDots% END IF IF ( MyPattern% = 8 ) THEN PATTERN &HFFFF,filla% END IF IF ( MyPattern% = 9 ) THEN PATTERN &HFFFF,fillb% END IF IF ( MyPattern% = 10 ) THEN PATTERN &HFFFF,fillc% END IF IF ( MyPattern% = 11 ) THEN PATTERN &HFFFF,filld% END IF IF ( MyPattern% = 12 ) THEN PATTERN &HFFFF,fille% END IF IF ( MyPattern% = 13 ) THEN PATTERN &HFFFF,fillf% END IF IF ( MyPattern% = 14 ) THEN PATTERN &HFFFF,fillg% END IF RETURN REM ********************** REM * * REM * Tfonts * REM * * REM ********************** Tfonts: WINDOW 4,"Font Mode",(0,0)-(ResX-10,30),0,1 WINDOW OUTPUT 4 MOUSE OFF GOSUB MenuOff GetFont: CLS GOSUB Tbeep INPUT "Font name : ",fontname$ CLS IF fontname$ = "exit" GOTO fontl IF fontname$ = "" GOTO GetFont fontok: fontname$ = fontname$ + ".font" GOSUB Cfont CLS WINDOW OUTPUT 2 WINDOW CLOSE 4 GOSUB font fontl: GOSUB MenuOn MOUSE ON RETURN REM ********************** REM * * REM * SmartMyBrush * REM * * REM ********************** SmartMyBrush: CALL SetDrMd& ( WINDOW(8),3 ) x% = MOUSE(1) y% = MOUSE(2) LINE (abs(x%-bx%),abs(y%-by%))-(abs(x%+bx%),abs(y%+by%)),1,b LINE (abs(x%-bx%),abs(y%-by%))-(abs(x%+bx%),abs(y%+by%)),1,b CALL SetDrMd& ( WINDOW(8),1 ) RETURN REM ********************** REM * * REM * SmartEraser * REM * * REM ********************** SmartEraser: CALL SetDrMd& ( WINDOW(8),3 ) x% = MOUSE(1) y% = MOUSE(2) LINE (abs(x%-5),abs(y%-5))-(abs(x%+5),abs(y%+5)),1,b LINE (abs(x%-5),abs(y%-5))-(abs(x%+5),abs(y%+5)),1,b CALL SetDrMd& ( WINDOW(8),1 ) RETURN REM ********************** REM * * REM * TPickMyBrush * REM * * REM ********************** TPickMyBrush: TMyBrush1: m0% = MOUSE(0) GOSUB GetXY xi% = MOUSE(3) yi% = MOUSE(4) TMyBrush2: GOSUB Tbeep GOSUB SaveDisplay WHILE MOUSE(0)<>0 GOSUB GetXY LINE (xi%,yi%)-(x%,y%),clrdraw%,b TMyBrush3: m0% = MOUSE(0) IF ABS(x%-MOUSE(1)) = 0 AND ABS(y%-MOUSE(2)) = 0 AND MOUSE(0)<>0 GOTO TMyBrush3 GOSUB RefreshDisplay WEND GOSUB RefreshDisplay GET (xi%,yi%)-(x%,y%),brush% bx% = INT(ABS(xi%-x%)/2) by% = INT(ABS(yi%-y%)/2) sx% = xi% ex% = x% sy% = yi% ey% = y% RETURN REM ******************************************** REM * * REM * SpecialMenu * REM * * REM ******************************************** REM ********************** REM * * REM * Tmix * REM * * REM ********************** SetPalette: MixPalette% = FALSE% MixColors% = FALSE% FOR x% = 0 TO x%= 31 TempRed ( x% ) = ColorRed ( x% ) TempGreen ( x% ) = ColorGreen ( x% ) TempBlue ( x% ) = ColorBlue ( x% ) NEXT x% GOSUB MenuOff WINDOW 10,"Color Mixer",,0,1 WINDOW OUTPUT 10 note% = 60 GOSUB Boxes GOSUB Tmix1 RETURN CleanPalette: SOUND 440,4,255,0 WINDOW OUTPUT 2 WINDOW CLOSE 10 GOSUB MenuOn RETURN Tmix: MOUSE OFF GOSUB SetPalette ON MOUSE GOSUB MixMessage MOUSE ON WHILE ( DoMix% ) SLEEP WEND GOSUB SetEvents GOSUB CleanPalette RETURN MixMessage: m0% = MOUSE(0) GOSUB GetXY GOSUB MixFlags GOSUB MixMsg RETURN MixFlags: IF ( y% > 120 ) THEN MixPalette% = TRUE% MixColors% = FALSE% END IF IF ( y% <= 120 ) THEN MixPalette% = FALSE% MixColors% = TRUE% END IF RETURN MixMsg: IF ( MixPalette% ) THEN GOSUB RGBmixer IF ( MixColors% ) THEN GOSUB RGBcolor RETURN Boxes: c1 = 0 c2 = 8 c3 = 16 c4 = 24 FOR x% = 0 TO 315 STEP 39 LINE (x%,0)-(x%+39,30),c1,bf LINE (x%,30)-(x%+39,60),c2,bf LINE (x%,60)-(x%+39,90),c3,bf LINE (x%,90)-(x%+39,120),c4,bf LINE (x%,0)-(x%+39,30),1,b LINE (x%,30)-(x%+39,60),1,b LINE (x%,60)-(x%+39,90),1,b LINE (x%,90)-(x%+39,120),1,b c1 = c1+1 c2 = c2+1 c3 = c3+1 c4 = c4+1 IF c1>7 THEN c1 = 7 IF c2>15 THEN c2 = 15 IF c3>23 THEN c3 = 23 IF c4>31 THEN c4 = 31 NEXT x% LINE (311,0)-(311,120),1 RETURN Tmix1: xr% = ( INT ( ( TempRed (clrdraw%) * 16 ) * 10 ) + 80 ) LINE (78,130)-(242,140),1,b LINE (xr%,131)-(xr%,139),1,b xg% = ( INT ( ( TempGreen ( clrdraw% ) * 16 ) * 10 ) + 80 ) LINE (78,145)-(242,155),1,b LINE (xg%,146)-(xg%,154),1,b xb% = ( INT ( ( TempBlue ( clrdraw% ) * 16 ) * 10 ) + 80 ) LINE (xb%,161)-(xb%,169),1,b LINE (78,160)-(242,170),1,b oldxr% = xr% oldxg% = xg% oldxb% = xb% LINE (20,125)-(250,175),1,b LINE (255,125)-(310,175),1,b LINE (1,126)-(14,174),clrdraw%,bf LINE (0,125)-(15,175),1,b LINE (260,130)-(305,148),1,b LINE (260,152)-(305,170),1,b CALL Move&(WINDOW(8),270,142) m$="USE" CALL Text&(WINDOW(8),SADD(m$+CHR$(0)),3) CALL Move&(WINDOW(8),263,165) m$="RESET" CALL Text&(WINDOW(8),SADD(m$+CHR$(0)),5) CALL Move&(WINDOW(8),31,138) m$="Red" CALL Text&(WINDOW(8),SADD(m$+CHR$(0)),3) CALL Move&(WINDOW(8),31,153) m$="Green" CALL Text&(WINDOW(8),SADD(m$+CHR$(0)),5) CALL Move&(WINDOW(8),31,168) m$="Blue" CALL Text&(WINDOW(8),SADD(m$+CHR$(0)),4) RETURN RGBcolor: PALETTE clrdraw%,TempRed(clrdraw%),TempGreen(clrdraw%),TempBlue(clrdraw%) cx=(x%/40)-(.47) cy=(y%/30)-(.5) wx%=cx wy%=cy clrdraw%=INT(wx%+(wy%*8)) IF ( clrdraw% > 31 ) THEN clrdraw% = 31 IF ( clrdraw% < 0 ) THEN clrdraw% = 0 note% = ( ( ( TempRed ( clrdraw% ) * 16 ) + ( TempBlue ( clrdraw% ) * 16 ) + ( TempGreen ( clrdraw% ) * 16 ) ) * 16 ) + 60 IF ( note% > 5000 ) THEN note% = 5000 SOUND note%,6,255,0 LINE ( oldxr%, 131 ) - ( oldxr%, 139 ),0 ,b xr% = INT ( ( TempRed ( clrdraw% ) * 16 ) * 10 ) + 80 LINE ( xr%, 131 ) - ( xr%, 139 ), 1, b LINE ( oldxg%, 146 ) - ( oldxg%, 154 ),0,b xg% = INT ( ( TempGreen ( clrdraw% ) * 16 ) * 10 ) + 80 LINE (xg%,146)-(xg%,154),1,b LINE (oldxb%,161)-(oldxb%,169),0,b xb% = INT((TempBlue(clrdraw%)*16)*10)+80 LINE (xb%,161)-(xb%,169),1,b LINE (1,126)-(14,174),clrdraw%,bf LINE (0,125)-(15,175),1,b wx% = 0 wy% = 0 oldxr% = xr% oldxg% = xg% oldxb% = xb% RETURN RGBmixer: IF ( (y%>131 AND y%<139) AND (x%>81 AND x%<239) ) THEN GOSUB red IF ( (y%>146 AND y%<154) AND (x%>81 AND x%<239) ) THEN GOSUB Green IF ( (y%>161 AND y%<169) AND (x%>81 AND x%<239) ) THEN GOSUB Blue IF ( (y%>131 AND y%<169) AND (x%>240 AND x%<310) ) THEN GOSUB RGBexit RETURN red: LINE (0,125)-(15,175),1,b m0% = MOUSE(0) GOSUB GetXY LINE (oldxr%,131)-(oldxr%,139),0 WHILE (MOUSE(0)<>0) GOSUB GetXY IF ( x% < 81 ) THEN x% = 81 IF ( x% > 239 ) THEN x% = 239 IF ( y% < 131 ) THEN y% = 131 IF ( y% > 139 ) THEN y% = 139 px = ((x%-80)/10)/16 IF ( px > 1 ) THEN px = 1 IF ( px < 0 ) THEN px = 0 LINE (1,126)-(14,174),clrdraw%,bf LINE (x%,131)-(x%,139),1 red1: m0% = MOUSE(0) IF (ABS(x%-MOUSE(1))=0 AND ABS(y%-MOUSE(2))=0 AND MOUSE(0)<>0) GOTO red1 LINE (79,131)-(241,139),0,bf TempRed(clrdraw%) = px PALETTE clrdraw%,TempRed(clrdraw%),TempGreen(clrdraw%),TempBlue(clrdraw%) WEND LINE (79,131)-(241,139),0,bf LINE (x%,131)-(x%,139),1 oldxr% = x% RETURN Green: LINE (0,125)-(15,175),1,b m0% = MOUSE(0) GOSUB GetXY LINE (oldxg%,161)-(oldxg%,169),0 WHILE MOUSE(0)<>0 GOSUB GetXY IF ( x% < 81 ) THEN x% = 81 IF ( x% > 239 ) THEN x% = 239 IF ( y% < 146 ) THEN y% = 146 IF ( y% > 125 ) THEN y% = 125 px = ((x%-80)/10)/16 IF ( px > 1 ) THEN px = 1 IF ( px < 0 ) THEN px = 0 LINE (1,126)-(14,174),clrdraw%,bf LINE (x%,146)-(x%,154),1 green1: m0% = MOUSE(0) IF (ABS(x%-MOUSE(1))=0 AND ABS(y%-MOUSE(2))=0 AND MOUSE(0)<>0 ) GOTO green1 LINE (79,146)-(241,154),0,bf TempGreen(clrdraw%) = px PALETTE clrdraw%,TempRed(clrdraw%),TempGreen(clrdraw%),TempBlue(clrdraw%) WEND LINE (79,146)-(241,154),0,bf LINE (x%,146)-(x%,154),1 oldxg% = x% RETURN Blue: LINE (0,125)-(15,175),1,b m0% = MOUSE(0) GOSUB GetXY LINE (oldxb%,161)-(oldxb%,169),0 WHILE ( MOUSE(0) <> 0 ) GOSUB GetXY IF ( x% < 81 ) THEN x% = 81 IF ( x% > 239 ) THEN x% = 239 IF ( y% < 161 ) THEN y% = 131 IF ( y% > 169 ) THEN y% = 139 px = ((x%-80)/10)/16 IF ( px > 1 ) THEN px = 1 IF ( px < 0 ) THEN px = 0 LINE (1,126)-(14,174),clrdraw%,bf LINE (x%,161)-(x%,169),1 TempBlue(clrdraw%) = px blue1: m0% = MOUSE(0) IF (ABS(x%-MOUSE(1))=0 AND ABS(y%-MOUSE(2))=0 AND MOUSE(0)<>0) GOTO blue1 LINE (79,161)-(241,169),0,bf PALETTE clrdraw% ,TempRed(clrdraw%),TempGreen(clrdraw%),TempBlue(clrdraw%) WEND LINE (79,161)-(241,169),0,bf LINE (x%,161)-(x%,169),1 oldxb% = x% RETURN RGBexit: IF ((x%<305 AND x%>260) AND (y%>131 AND y%<148)) THEN GOSUB UseBox IF ((x%<305 AND x%>260) AND (y%>152 AND y%<169)) THEN GOSUB ResetBox RETURN UseBox: SOUND 440,4,255,0 FOR l% = 0 TO 3 LINE (261,131)-(304,147),1,b FOR d% = 0 TO 1000:NEXT d% LINE (261,131)-(304,147),0,b FOR d% = 0 TO 1000:NEXT d% NEXT l% LINE (261,131)-(304,147),0,b DoMix% = FALSE% MenuRoutine% = FALSE% RETURN ResetBox: SOUND 440,4,255,0 FOR x% = 0 TO 31 TempRed(x%) = ColorRed(x%) TempGreen(x%) = ColorGreen(x%) TempBlue(x%) = ColorBlue(x%) PALETTE x%,TempRed(x%),TempGreen(x%),TempBlue(x%) NEXT x% LINE (260,152)-(305,170),1,b FOR l% = 0 TO 3 LINE (261,153)-(304,169),1,b FOR d% = 0 TO 1000:NEXT d% LINE (261,153)-(304,169),0,b FOR d% = 0 TO 1000:NEXT d% NEXT l% LINE (261,153)-(304,169),0,b DoMix% = FALSE% MenuRoutine% = FALSE% RETURN REM ********************** REM * * REM * Tmatch * REM * * REM ********************** Tmatch: WHILE MOUSE (0) = 0 x% = MOUSE(1) y% = MOUSE(2) WEND GOSUB Tbeep x% = MOUSE(1) y% = MOUSE(2) clrdraw% = POINT(x%,y%) RETURN REM ********************** REM * * REM * Tpatternfill * REM * * REM ********************** Tpatternfill: GOSUB SaveDisplay GOSUB Tbeep GOSUB SelectMyPattern m0% = MOUSE(0) GOSUB GetXY COLOR clrdraw% CALL Flood&(WINDOW(8),1,x%,y%) GOSUB Tbeep RETURN REM ********************** REM * * REM * Tair * REM * * REM ********************** Tair: GOSUB SaveDisplay Tair1: WHILE MOUSE(0)<>0 GOSUB GetXY PSET (x%-10*RND(1),y%-8*RND(1)),clrdraw% WEND RETURN REM ********************** REM * * REM * Tboxpattern * REM * * REM ********************** Tboxpattern: GOSUB SaveDisplay Tboxpattern1: GOSUB SelectMyPattern GOSUB Tbeep m0% = MOUSE(0) GOSUB GetXY xi% = MOUSE(3) yi% = MOUSE(4) xf% = MOUSE(5) yf% = MOUSE(6) WHILE MOUSE (0) <> 0 GOSUB GetXY LINE (xi%,yi%)-(x%,y%),clrdraw%,bf tboxpattern3: m0% = MOUSE(0) IF ABS(x%-MOUSE(1)) = 0 AND ABS(y%-MOUSE(2)) = 0 AND MOUSE(0)<>0 GOTO tboxpattern3 GOSUB RefreshDisplay LINE (xi%,yi%)-(x%,y%),clrdraw%,bf WEND GOSUB RefreshDisplay xi% = MOUSE(3) yi% = MOUSE(4) xf% = MOUSE(5) yf% = MOUSE(6) LINE (xi%,yi%)-(xf%,yf%),clrdraw%,bf RETURN REM ********************** REM * * REM * MyBrush * REM * * REM ********************** MyBrush: GOSUB SaveDisplay x% = MOUSE(1)-bx% y% = MOUSE(2)-by% WHILE MOUSE(0)<>0 GOSUB GetXY PUT (x%,y%),brush%,PSET WEND RETURN REM ********************** REM * * REM * Ttext * REM * * REM ********************** Ttext: lmsg$="Text Mode press ESC key to exit" CALL SetWindowTitles&(WINDOW(7),-1,SADD(lmsg$+CHR$(0)) ) GOSUB WindowStruct CALL SetDrMd& ( WINDOW(8), 3) CALL SetAPen& ( WINDOW(8), clrdraw%) MOUSE ON m0% = MOUSE(0) LetterCounter% = 0 GOSUB FontXY GOSUB SetCursor WHILE ( letter$ <> "") letter$=INKEY$ WEND ascii = 0 TextLoop% = 1 ON MOUSE GOSUB SetText MOUSE ON WHILE ( TextLoop% ) WHILE ( letter$ = "" ) letter$ = INKEY$ WEND GOSUB FilterLetter WEND LINE( CounterX%, CounterY% )-( CursorX%, CursorY% ),0,b CALL SetDrMd& ( WINDOW(8), 1 ) GOSUB SetEvents RETURN FilterLetter: ascii = ASC (letter$) IF ( ascii = 27 ) THEN TextLoop% = 0 IF ( ascii = 8 ) THEN GOSUB BackUpCursorX IF ( ascii = 13 ) THEN GOSUB UpdateCursorY IF ( ascii >= 32 AND ascii <= 126 ) THEN GOSUB UpdateCursorX letter$ = "" ascii = 0 RETURN SetCursor: LINE( CounterX%, CounterY% )-( CursorX%, CursorY% ),0,b RETURN PutChar: CALL SetDrMd& ( WINDOW(8), 0 ) letter$ = LetterBuffer$ ( LetterCounter% ) CALL Text&( WINDOW(8), SADD ( letter$ + CHR$ (0) ), 1) CALL SetDrMd& ( WINDOW(8), 3 ) RETURN UpdateCursorX: GOSUB ConsoleBuffers LINE( CounterX%, CounterY% )-(CursorX%,CursorY%),clrdraw%,b CALL Move&( WINDOW(8), CounterX%, CursorY% - FontOffSet% ) GOSUB PutChar CounterX% = ( CounterX% + CharWidth% ) IF ( CounterX% > ScreenWidth% ) THEN CounterX% = ScreenWidth% IF ( CounterX% < FontWidth% ) THEN CounterX% = FontWidth% CursorX% = ( CounterX% + FontWidth% ) CursorY% = ( CounterY% + FontHeight% ) LINE( CounterX%, CounterY% )-(CursorX%,CursorY%),clrdraw%,b LetterCounter% = ( LetterCounter% + 1 ) IF ( LetterCounter% > 100 ) THEN LetterCounter% = 0 RETURN UpdateCursorY: LINE ( CounterX%, CounterY% )-(CursorX%,CursorY%),clrdraw%,b CALL Move& ( WINDOW(8), CounterX%, CursorY% - FontOffSet% ) GOSUB SaveDisplay GOSUB WackConsoleBuffers CounterX% = StartX% CounterY% = ( CounterY% + FontHeight% ) StartY% = CounterY% CALL Move& ( WINDOW(8), CounterX%, CursorY% - FontOffSet% ) IF ( CounterY% > ScreenHeight% ) THEN CounterY% = ScreenHeight% IF ( CounterY% < FontHeight% ) THEN CounterY% = FontHeight% CursorX% = ( CounterX% + FontWidth% ) CursorY% = ( CounterY% + FontHeight% ) LINE( CounterX%, CounterY% )-(CursorX%,CursorY%),clrdraw%,b GOSUB ConsoleBuffers RETURN BackUpCursorX: LINE( CounterX%, CounterY% )-(CursorX%,CursorY%),clrdraw%,b CounterX% = StartX% CounterY% = StartY% CursorX% = ( CounterX% + FontWidth% ) CursorY% = ( CounterY% + FontHeight% ) GOSUB RefreshDisplay limit% = ( LetterCounter% - 1 ) IF ( limit% <= 0 ) THEN GOTO NoUndo FOR UndoX% = 0 TO limit% LINE( CounterX%, CounterY% )-(CursorX%,CursorY%),clrdraw%,b LINE( CounterX%, CounterY% )-(CursorX%,CursorY%),clrdraw%,b CharWidth% = UndoBuffers% ( UndoX% ) LetterCounter% = UndoX% CALL Move&( WINDOW(8), CounterX%, CursorY% - FontOffSet% ) GOSUB PutChar CounterX% = CounterX% + CharWidth% CursorX% = ( CounterX% + FontWidth% ) CursorY% = ( CounterY% + FontHeight% ) NEXT UndoX% NoUndo: LINE( CounterX%, CounterY% )-(CursorX%,CursorY%),clrdraw%,b RETURN ConsoleBuffers: LetterBuffer$ ( LetterCounter% ) = letter$ CharWidth% = TextLength& ( WINDOW(8), SADD ( letter$ + CHR$(0) ) ,1 ) UndoBuffers% ( LetterCounter% ) = CharWidth% RETURN WackConsoleBuffers: FOR NoBuffers% = 0 TO 100 LetterBuffer$ ( NoBuffers% ) = " " UndoBuffers% ( NoBuffers% ) = 0 NEXT NoBuffers% LetterCounter% = 0 RETURN FontXY: CounterX% = 0 CounterY% = 0 CursorX% = ( CounterX% + CharWidth% ) CursorY% = ( CounterY% + FontHeight% ) ScreenHeight% = 256 ScreenWidth% = 320 RETURN SetText: GOSUB WackConsoleBuffers m0% = MOUSE(0) LINE( CounterX%, CounterY% )-(CursorX%,CursorY%),clrdraw%,b StartX% = MOUSE(1) StartY% = MOUSE(2) CounterX% = StartX% CounterY% = StartY% CursorX% = ( CounterX% + FontWidth% ) CursorY% = ( CounterY% + FontHeight% ) LINE( CounterX%, CounterY% )-(CursorX%,CursorY%),clrdraw%,b RETURN REM ********************************** REM * * REM * SubRoutines for B-paint * REM * * REM ********************************** REM **************************** REM * * REM * FalseFlag * REM * * REM **************************** FalseFlag: bnew% = FALSE% bload% = FALSE% bsave% = FALSE% bsaveas% = FALSE% bprint% = FALSE% bundo% = FALSE% bquit% = FALSE% bdraw% = FALSE% bline% = FALSE% brect% = FALSE% bellipse% = FALSE% bbox% = FALSE% bdisk% = FALSE% bpaint% = FALSE% beraser% = FALSE% bselect% = FALSE% bpattern% = FALSE% bfonts% = FALSE% bpickmybrush% = FALSE% bmix% = FALSE% bmatch% = FALSE% bpatternfill% = FALSE% bair% = FALSE% bboxpattern% = FALSE% bmybrush% = FALSE% btext% = FALSE% bworkbench% = FALSE% RETURN RVideo: CALL SetDrMd& (WINDOW(8),3) RETURN IVideo: CALL SetDrMd& (WINDOW(8),1) RETURN font: IF pfont&<>0 THEN CALL CloseFont& (pfont&) fontname$ = fontname$ + CHR$ (0) textAttr&(0) = SADD (fontname$) textAttr&(1) = ( size%*65536&+style%*256+flags% ) pfont& = OpenDiskFont&(VARPTR(textAttr&(0))) IF pfont& <> 0 THEN CALL SetFont& ( WINDOW(8),pfont& ) GOSUB FontStruct END IF RETURN FontStruct: FontHeight% = PEEKW ( WINDOW(8) + 58 ) FontWidth% = PEEKW ( WINDOW(8) + 60 ) FontBaseLine% = PEEKW ( WINDOW(8) + 62 ) FontOffSet% = ABS ( FontHeight% - FontBaseLine% ) FontSpacing% = 2 RETURN REM This is a hack done on friday nite Oct 2, 1987 REM I came with these few lines ( but good ones... ) REM to my friend Frida Wosk to whom I promised a wild REM AmigaBASIC program : REM B-Paint © copyright 1987,1988 Ed Silva. BorderLess: sWindow& = WINDOW(7) sWindowFlags& = ( sWindow& + 24 ) sFridaWoskIDCMP& = PEEKL( sWindowFlags& ) sEdSilvaIDCMP& = 2048 sLoveIDCMP& = ( sFridaWoskIDCMP& OR sEdSilvaIDCMP& ) POKEL sWindowFlags&,sLoveIDCMP& CALL SizeWindow&( sWindow&,-1 ,-1 ) CALL SizeWindow&( sWindow&, 1, 1 ) RETURN SaveDisplay: GET (0,0)-(320,256),oops% RETURN RefreshDisplay: PUT (0,0),oops%,PSET RETURN Cfont: RETURN Tbeep: WAVE 1,SIN SOUND 1320,1,255,1 RETURN WindowStruct: sWindow& = WINDOW(7) sScreen& = PEEKL(sWindow&+46) sViewPort& = sScreen&+44 sRastPort& = sScreen&+84 sColorMap& = PEEKL(sViewPort&+4) colorTab& = PEEKL(sColorMap&+4) sBitMap& = PEEKL(sRastPort&+4) scrWidth% = PEEKW(sScreen&+12) scrHeight% = PEEKW(sScreen&+14) scrDepth% = PEEK(sBitMap&+5) nColors% = 2^scrDepth% FOR kk = 0 TO scrDepth%-1 bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4)) NEXT RETURN GetXY: x% = MOUSE(1) y% = MOUSE(2) RETURN LeMenu: MenuOn: MENU 1,0,1,"PROJECT" MENU 1,1,1,"New " MENU 1,2,1,"Open " MENU 1,3,1,"Save " MENU 1,4,1,"Save as" MENU 1,5,1,"Print " MENU 1,6,1,"Clear " MENU 1,7,1,"Undo " MENU 1,8,1,"Quit " MENU 2,0,1,"SHAPE" MENU 2,1,1,"Freehand " MENU 2,2,1,"Line " MENU 2,3,1,"Empty_Box " MENU 2,4,1,"Empty_Oval" MENU 2,5,1,"Solid_Box " MENU 2,6,1,"Solid_Oval" MENU 2,7,1,"Paint " MENU 2,8,1,"Eraser " MENU 3,0,1,"PICK" MENU 3,1,1,"Color " MENU 3,2,1,"Pattern" MENU 3,3,1,"Font " MENU 3,4,1,"Brush " MENU 4,0,1,"SPECIAL" MENU 4,1,1,"Palette " MENU 4,2,1,"MatchColor " MENU 4,3,1,"PatternFill" MENU 4,4,1,"SprayPaint " MENU 4,5,1,"BoxPattern " MENU 4,6,1,"MyBrush " MENU 4,7,1,"Text " MENU ON RETURN MenuOff: MENU 1,0,0,"PROJECT" ' PROJECT... MENU 2,0,0,"SHAPE" ' SHAPES... MENU 3,0,0,"PICK" ' PICK... MENU 4,0,0,"SPECIAL" ' COLOR... MENU OFF RETURN DiskFile0: df$ = "df0:" pathname$ = df$+dir$ ON ERROR GOTO ErrorBas CHDIR pathname$ RETURN DiskFile1: df$ = "df1:" pathname$ = df$+dir$ ON ERROR GOTO ErrorBas CHDIR pathname$ RETURN savedf0: df$ = "df0:" pathname$ = df$+dir$ ON ERROR GOTO ErrorBas CHDIR pathname$ RETURN savedf1: df$ = "df1:" pathname$ = df$+dir$ ON ERROR GOTO ErrorBas CHDIR pathname$ RETURN ErrorBas: WINDOW CLOSE 1 CALL ScreenToFront& (sScreen&) WINDOW OUTPUT 4 IF ERR = 53 THEN ErrorMessage$ = " File not found...!" ELSEIF ERR = 61 THEN ErrorMessage$ = " Disk is full...!" ELSEIF ERR = 68 THEN ErrorMessage$ = " Device unavaible ELSEIF ERR = 70 THEN ErrorMessage$ = "Disk write protected...!" ELSEIF ERR = 74 THEN ErrorMessage$ = "Volume not mounted...!" END IF RESUME SystemError SystemError: ON ERROR GOTO 0 CLS GOSUB Tbeep GOSUB Tbeep PRINT PRINT ErrorMessage$ FOR x% = 0 TO 10000:NEXT x% WINDOW CLOSE 1 WINDOW CLOSE 4 CALL ScreenToFront& (sScreen&) WINDOW OUTPUT 2 FOR x% = 3 TO 10:WINDOW CLOSE x%:NEXT x% GOSUB MenuOn MENU ON RETURN REM *************************************** REM * * REM * SetUp for B-Paint * REM * * REM *************************************** SetUp: CLS WAVE 1,SIN WAVE 0,SIN MENU OFF BREAK ON LowRes: WINDOW CLOSE 1 SCREEN 1,320,256,5,1 MiAmor$ = " B-Paint © 1987,1988 Ed Silva" WINDOW 2,,(0,9)-(311,185),0,1 WINDOW OUTPUT 2 AREA (100,100) AREAFILL CLS LOCATE 20,1 PRINT " Hold on a second..." CALL SetWindowTitles& ( WINDOW(7),-1,SADD(MiAmor$+CHR$(0)) ) GOSUB WindowStruct GOSUB BorderLess GOSUB RGBLow GOSUB LeMenu FOR x% = 0 TO 31 PALETTE x%,ColorRed(x%),ColorGreen(x%),ColorBlue(x%) NEXT x% ResX = 320 ResY = 256 GOSUB Begin PRINT " " INPUT " HIT TO START...",TheStart$ CLS GOSUB SaveDisplay RETURN RGBLow: FOR x% = 0 TO 31 READ ColorRed(x%) READ ColorGreen(x%) READ ColorBlue(x%) TempRed(x%) = ColorRed(x%) TempGreen(x%) = ColorGreen(x%) TempBlue(x%) = ColorBlue(x%) NEXT x% DATA 1,1,1 DATA 0,0,0 DATA .2,0,0 DATA .4,0,0 DATA .6,0,0 DATA .8,0,0 DATA 1,0,0 DATA 1,.2,0 DATA 1,.4,0 DATA 1,.6,0 DATA 1,.8,0 DATA 1,1,0 DATA .8,1,0 DATA .6,1,0 DATA .4,1,0 DATA .2,1,0 DATA 0,1,0 DATA 0,1,.2 DATA 0,1,.4 DATA 0,1,.6 DATA 0,1,.8 DATA 0,1,1 DATA 0,.8,1 DATA 0,.6,1 DATA 0,.4,1 DATA 0,.2,1 DATA 0,0,1 DATA 0,0,.8 DATA 0,0,.6 DATA 0,0,.4 DATA 0,0,.2 DATA 1,.5,.1 REM ------- This is where the NEW pattern is at...------------ LowPattern: loops: FOR x% = 0 TO 7 READ Bricks%(x%) Solid%(x%) = &HFFFF NEXT x% FOR x% = 0 TO 7 READ VertLines%(x%) NEXT x% FOR x% = 0 TO 7 READ DenseDots%(x%) NEXT x% FOR x% = 0 TO 7 READ BoxSmall%(x%) NEXT x% FOR x% = 0 TO 7 READ BoxBig%(x%) NEXT x% FOR x% = 0 TO 7 READ Checkers%(x%) NEXT x% FOR x% = 0 TO 7 READ RightLines%(x%) NEXT x% FOR x% = 0 TO 7 filla%(x%) = 21845 NEXT x% FOR x% = 0 TO 7 READ fillb%(x%) NEXT x% FOR x% = 0 TO 7 READ fillc%(x%) NEXT x% FOR x% = 0 TO 7 READ filld%(x%) NEXT x% FOR x% = 0 TO 7 READ filld%(x%) NEXT x% FOR x% = 0 TO 7 READ fille%(x%) NEXT x% FOR x% = 0 TO 7 READ fillf%(x%) NEXT x% FOR x% = 0 TO 7 READ fillg%(x%) NEXT x% REM Bricks DATA &hffff,257,257,257,&hffff,4112,4112,4112 REM vertical lines DATA 257,257,257,257,257,257,257,257 REM Dotsdense DATA &haaaa,&h5555,&haaaa,&h5555,&haaaa,&h5555,&haaaa,&h5555 REM squares DATA &hffff,&h8181,&h8181,&h8181,&h8181,&h8181,&h8181,&h8181 REM DotsLight DATA 255,255,255,255,&hff00,&hff00,&hff00,&hff00 REM boxes DATA &hffff,1,1,1,1,1,1,1 DATA 257,514,1028,2056,4112,8224,16448,&h8080 DATA 0,&hffff,0,&HFFFF,0,&HFFFF,0,&HFFFF DATA &h8888,&h8888,&h8888,&h8888,&h8888,&h8888,&h8888,&h8888 DATA &hffff,0,0,0,&hffff,0,0,0 DATA &hffff,&h8888,&h8888,&h8888,&hffff,&h8888,&h8888,&h8888 DATA 4369,&haaaa,17476,&haaaa,4369,&haaaa,17476,&haaaa DATA 4369,8738,17476,&h8888,4369,8738,17476,&h8888 DATA &h8888,17476,8738,4369,&h8888,17476,8738,4369 DATA 4369,&haaaa,17476,&haaaa,4369,&haaaa,17476,&haaaa DATA 4369,&haaaa,17476,&haaaa,4369,&haaaa,17476,&haaaa DATA 4369,&haaaa,17476,&haaaa,4369,&haaaa,17476,&haaaa RETURN Begin: clrdraw% = 1 MENU ON MOUSE ON BREAK ON ILBMname$ = "Untitled" size% = 8 style% = 0 flags% = 0 GOSUB FontStruct GOSUB MenuOn SetEvents: ON MENU GOSUB CheckMenu MENU ON ON MOUSE GOSUB DoSub MOUSE ON ON BREAK GOSUB Pquit BREAK ON RETURN DummyEvents: ON MENU GOSUB DummyWork MENU ON ON MOUSE GOSUB DummyWork MOUSE ON ON BREAK GOSUB DummyWork BREAK ON RETURN DummyWork: RETURN MyLine: LINE ( LineStartX%, LineStartY%)-(x%,y%),clrdraw% RETURN REM ************************************** REM * * REM * END OF B-Paint * REM * * REM **************************************