\START92\
\COMMENT=PicTools Suite by Rick Coogle
\NAME=pictools
\FILE=PICTOOLS.92P
()
Prgm
Local p,po,zpic,tpic,i,j,pmat,fz,k,cd,rd,box,k,cur,mr,mc,m,f,pp,pn,np,cc1,cc2,rc1,rc2,cl,t
Define box()=Prgm
PxlLine lr,lc,r+1,lc,\(-)\1
PxlLine lr,lc,lr,c+1,\(-)\1
PxlLine lr,c+1,r+1,c+1,\(-)\1
PxlLine r+1,lc,r+1,c+1,\(-)\1
EndPrgm
Define cur(ky,l)=Prgm
XorPic pcr,r,c
If ky=338
r-1\->\r
If ky=344
r+1\->\r
If ky=337
c-1\->\c
If ky=340
c+1\->\c
If ky=4434
r-5\->\r
If ky=4440
r+5\->\r
If ky=4433
c-5\->\c
If ky=4436
c+5\->\c
If c<0
0\->\c
If c>238
238\->\c
If r<0
0\->\r
If r>102
102\->\r
If ky=13 and l=1 Then
r\->\lr
c\->\lc
EndIf
XorPic pcr,r,c
EndPrgm
false\->\po
false\->\fz
false\->\pp
setGraph("Axes","OFF")
setFold(pictool)
ClrDraw
FnOff 
PxlText "PicZoom 2.0 by Rick Coogle",47,47
Loop
If pp Then
RplcPic tpic
false\->\pp
EndIf
DelVar r,c,lr,lc
ToolBar
Title "File"
Item "Open\...\",o
Item "Save\...\",s
Item "Save Matrix",sm
Item "Exit",e
Title "Tools"
Item "PicMaker\...\",pm
Item "PicPlot\...\",pl
Item "Generate Pic\...\",gp
Title "Zoom"
Item "Zoom In "&when(fz,"?",""),zi
Item "Restore "&when(fz,"","?"),r
Title "About\...\",a
EndTBar
Cycle
Lbl e
setGraph("Axes","ON")
setFold(main)
setMode("split1app","home")
Exit
Lbl a
Dialog
Title "About PicTools"
Text "PicTools v2.0e"
Text "Created by Rick Coogle"
Text "\(C)\1998 CoolSoft"
EndDlog
Cycle
Lbl o
Dialog
Title "Open PicFile"
Request "Filename",p
EndDlog
If ok=0
Cycle
If getType(#p)\!=\"PIC" Then
Text "INVALID FILE"
Goto o
Else
ClrDraw
RclPic #p,1,1
true\->\po
false\->\fz
EndIf
Cycle
Lbl zi
StoPic zpic
If not po Then
Text "There is no open pic"
Cycle
EndIf
true\->\fz
51\->\r
119\->\c
PxlText "1st Corner?",90,0
XorPic pcr,r,c
Loop
inkey()\->\k
cur(k,1)
If getType(lc)="NUM"
Exit
EndLoop
PxlText "2nd Corner?",90,0
lr\->\r
lc\->\c
Loop
inkey()\->\k
box()
cur(k,0)
box()
If k=13
Exit
EndLoop
r-1-lr\->\mr
c-(lc+1)\->\mc
If sign(mr)=1 and sign(mc)=1 Then
newMat(mr,mc)\->\pmat
Else
Text "Invalid ZoomBox!"
Goto r
EndIf
0\->\mc
PxlText "Scanning\...\ ",90,0
For i,lc+1,c-1
0\->\mr
mc+1\->\mc
For j,lr+1,r-1
mr+1\->\mr
PxlText string(j),90,70
If pxlTest(j,i)
1\->\pmat[mr,mc]
EndFor
EndFor
ClrDraw
colDim(pmat)\->\cd
rowDim(pmat)\->\rd
Text "Dimensions: "&string(rd)&"X"&string(cd)
For j,1,rd
For i,1,cd
If pmat[j,i]=1 Then
If j*3\<=\102 or i*3\>=\0
XorPic blk,j*3,cd+i*3
EndIf
EndFor
EndFor
Cycle
Lbl r
false\->\fz
RplcPic zpic
Cycle
Lbl s
Dialog
Title "Store Pic"
Request "Filename",p
EndDlog
If ok=0
Cycle
StoPic #p
Cycle
Lbl sm
pmat\->\zoommat
Text "MATRIX STORED IN ZOOMMAT"
Cycle
Lbl gp
""\->\p
StoPic tpic
Dialog
Title "Generate Picture"
Request "Matrix name",f
Request "New Pic Name",p
EndDlog
If ok=0
Cycle
ClrDraw
colDim(#f)\->\c
rowDim(#f)\->\r
PxlText "GENERATING\...\",90,0
For i,1,c
PxlText string(i),90,68
If newMat(16,1)=subMat(#f,1,i,16,i)
Cycle
For j,1,r
If #f[j,i]=1
PxlOn j-1,i-1
EndFor
EndFor
StoPic #p,0,0,c,r
true\->\pp
Cycle
Lbl pm
StoPic tpic
ClrIO
Dialog
Title "PictureMaker 2.0e"
Request "Program Name",pn
Request "PicVar Name",p
Request "New PicVar name",np
EndDlog
If ok=0
Cycle
ClrDraw
For i,0,102
PxlHorz i
EndFor
AndPic #p
PxlText "1st Corner?",85,0
Input 
(xc-xmin)/\Delta\x\->\cc1
abs((yc-ymin)/\Delta\y-102)\->\rc1
PxlText "2nd Corner?",85,0
Input 
(xc-xmin)/\Delta\x\->\cc2
abs((yc-ymin)/\Delta\y-102)\->\rc2
PxlText "Scanning\...\ ",85,0
{}\->\cl
0\->\c
For i,cc1,cc2
For j,0,rc1+rc2
PxlText string(j),85,70
If pxlTest(j,i) Then
c+1\->\c
j\->\cl[c]
c+1\->\c
i\->\cl[c]
EndIf
EndFor
EndFor
list\to\mat(cl,2)\->\cl
Disp "GENERATING PROGRAM CODE\...\"
expr("Define "&pn&"()=Prgm:ClrDraw:NewPic "&string(cl)&","&np&":RclPic "&np&":StoPic "&np&",0,0,"&string(int(cc1+cc2))&","&string(int(rc1+rc2))&":EndPrgm")
Disp "DONE"
true\->\pp
Cycle
Lbl pl
StoPic tpic
ClrDraw
setGraph("axes","off")
true\->\pp
0\->\k
Lbl ss
If k=99
PxlText "CLEAR",18,195
For i,0,186,6
RplcPic gblk,0,i
EndFor
StoPic t,0,0,192,6
For i,0,93,6
RplcPic t,i,0
EndFor
PxlLine 67,193,67,226
PxlLine 67,193,84,193
PxlLine 84,193,84,226
PxlLine 84,226,67,226
For i,0,31
PxlOff 68,194+i
EndFor
StoPic t,68,194,31,1
For i,0,15
RplcPic t,68+i,194
EndFor
newMat(16,32)\->\m
0\->\r
0\->\c
PxlText "PicPlot 3.0",96,0
PxlText "F1-Help",36,195
XorPic cblk,6*r,6*c
Loop
PxlText "R:"&string(r)&" ",0,195
PxlText "C:"&string(c)&" ",9,195
PxlText "READY",18,195
inkey()\->\k
If k=268 Then
ClrIO
Disp "-COMMANDS-","C-Clear","O-Open","S-Save Pic","M-Save Matrix","Q-Quit"
Pause 
Cycle
EndIf
If k=99
Goto ss
If k=109 Then
PxlText "MATR ",18,195
Request "Matrix Name",f
If ok=0
Cycle
m\->\#f
EndIf
If k=115 Then
PxlText "SAVE ",18,195
Request "Filename",f
If ok=0
Cycle
StoPic #f,68,194,32,16
EndIf
If k=111 Then
PxlText "OPEN ",18,195
Request "Matrix name",f
If ok=0
Cycle
If getType(#f)="NONE" Then
Text "FILE DOESN'T EXIST"
Cycle
EndIf
rowDim(#f)\->\rd
colDim(#f)\->\cd
If cd>32 or rd>16 Then
Text "INVALID MATRIX"
Cycle
EndIf
For i,1,cd
PxlText string(i),96,200
If newMat(rd,1)=subMat(#f,1,i,rd,i)
Cycle
For j,1,rd
If #f[j,i]=1 Then
RclPic pblk,(j-1)*6+1,(i-1)*6+1
PxlOn 67+j,193+i
EndIf
EndFor
EndFor
PxlText "IMPT ",18,195
#f\->\m
While rd\!=\16
PxlText string(rd),96,200
list\to\mat(augment(mat\to\list(m),newList(cd)),cd)\->\m
rowDim(m)\->\rd
EndWhile
While cd\!=\32
PxlText string(cd),96,200
augment(m,newMat(16,1))\->\m
colDim(m)\->\cd
EndWhile
PxlText "  ",96,200
EndIf
If k=113
Exit
XorPic cblk,r*6,c*6
If k=344
r+1\->\r
If k=338
r-1\->\r
If k=340
c+1\->\c
If k=337
c-1\->\c
If k=13 Then
If m[r+1,c+1]=0 Then
RclPic pblk,r*6+1,c*6+1
PxlOn 68+r,194+c
1\->\m[r+1,c+1]
Else
XorPic pblk,r*6+1,c*6+1
PxlOff 68+r,194+c
0\->\m[r+1,c+1]
EndIf
EndIf
If c<0
0\->\c
If c>31
31\->\c
If r<0
0\->\r
If r>15
15\->\r
XorPic cblk,r*6,c*6
EndLoop
EndLoop
EndPrgm

\STOP92\