home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / pictures / bit / BITMEIST.OPL < prev    next >
Text File  |  1992-01-01  |  16KB  |  618 lines
  1. PROC main:    
  2.     local key%,list$(18),a$(5),mod%
  3.     global h&,w&,xcur%,ycur%,id%(2),idmax%,idat%,xan%,yan%,anbool%,clip%
  4.     global name$(2,128),viewwin%(2),statwin%,viewwin$(8),statwin$(10),short$(2,10)
  5.     list$="NGOASLCIEBVURX" 
  6.     statwin$="Status On"
  7.     viewwin$="View On"
  8.     idat% = 1
  9.     statwin% = gCREATE(180,6,60,70,0) : gborder 1  REM Create Status Window
  10.     REM Need to fill in Status Window
  11.     gAT 12,10 : GXprint "Status",2    
  12.     WHILE 1         REM Main loop of program
  13.         IF statwin$="Status Off"  AND idmax%>0
  14.             Statup:
  15.         ENDIF
  16.         if idmax%>0
  17.             IF anbool%
  18.                 gAT min(xan%,xcur%),min(yan%,ycur%)
  19.                 CURSOR id%(idat%),0,max((xcur%-xan%+4),xan%-xcur%+4),max((ycur%-yan%+4),yan%-ycur%+4)
  20.             ELSE
  21.                 cursor id%(idat%),0,4,4    
  22.             ENDIF
  23.             key%=GET : mod%=KMOD
  24.         else
  25.                 key%=290
  26.         endif
  27.         If key%=290 or key%>512    REM Menu Key was hit
  28.             IF key%>512 
  29.                 key%=(key%-512)
  30.                 IF loc(list$,chr$(key%))=0
  31.                     continue
  32.                 ENDIF
  33.             ELSE    
  34.                 mInit
  35.                 mCARD "File","New File",%N,"Open File",%O,"Save as",%A,"Save",%S,"Close Bitmap",%L
  36.                 mCARD "Edit","Copy",%C,"Insert",%I,"Change Bitmap",%G
  37.                 mCARD "Draw","Empty Box",%E,"Filled Box",%B
  38.                 mCARD "Special",viewwin$,%V,statwin$,%U,"Clear Screen",%R,"Exit",%X
  39.                 key%=MENU
  40.             ENDIF
  41.             IF key%         REM Not Esc
  42.                 a$="proc"+CHR$(key%)        REM Set which proc
  43.                 @(a$):      REM Call the correct procedure
  44.             ENDIF
  45.         ELSE                    REM IF keyhit is Not Psion-Something
  46.             IF key%=8 and anbool%=1   rem Delete
  47.                 cut:
  48.                 continue
  49.             endif   
  50.             IF key%>255 AND key<260
  51.                 DIRECT:(key%,mod%)
  52.             ENDIF
  53.            
  54.             IF key%=32 AND anbool%=0         REM Space
  55.                 gFILL 4,4,2
  56.                 gUSE viewwin%(idat%)
  57.                 gAT (xcur%+3)/4,(ycur%+3)/4 : gFill 1,1,2
  58.                 gUSE id%(idat%)
  59.             ENDIF    
  60.         ENDIF
  61.     ENDWH
  62. ENDP    
  63.  
  64. PROC PROCR:
  65.         if idmax%=0
  66.                 giprint "Load Bitmap First..."
  67.                 return
  68.         endif
  69.     IF abandon:("Clear Bitmap") 
  70.             giprint "Clearing Bitmap..."
  71.             if anbool%
  72.                anbool%=0
  73.         endif
  74.         gAT 1,1 : gFILL (w&*4),(h&*4),1
  75.         ycur%=1:xcur%=1    
  76.         gSETWIN 0,0
  77.         gUSE viewwin%(idat%) : gCLS :gAT 1,1 
  78.         gUSE id%(idat%)
  79.     ENDIF
  80. ENDP
  81.  
  82. PROC PROCL:             REM Close Bitmap
  83.     IF idmax%=0
  84.         beep 2,400 :GIPRINT "Load Bitmap First..."
  85.         RETURN
  86.     ENDIF
  87.     if abandon:("Close Bitmap")
  88.             giprint "Closing Bitmap..."
  89.                 anbool%=0
  90.         gCLOSE id%(idat%)    
  91.         gCLOSE viewwin%(idat%)
  92.         IF idat%=1 AND idmax%=2
  93.             viewwin%(1)=viewwin%(2)
  94.             id%(1)=id%(2)
  95.             name$(1)=name$(2)
  96.             short$(1)=short$(2)
  97.         ENDIF    
  98.         idmax%=idmax%-1
  99.         idat%=1
  100.         IF idmax%
  101.                 gUSE id%(1) :gVISIBLE ON
  102.                 xcur%=1:ycur%=1
  103.                 w&=(gWIDTH-2)/4 : h&=(gHEIGHT-2)/4
  104.                 IF viewwin$="View Off"
  105.                 gUSE viewwin%(1) :gVISIBLE ON
  106.                 gUSE id%(1)
  107.                 ENDIF
  108.             ELSE
  109.                 IF statwin$="Status Off"
  110.                 statwin$="Status On"
  111.                 gUSE statwin%
  112.                 gVisible OFF
  113.                 endif
  114.             endif        
  115.     ENDIF
  116.     RETURN
  117. ENDP
  118.  
  119. PROC Abandon:(temp$)
  120.     dInit
  121.     dTEXT "",temp$,2
  122.     dTEXT "","Are You Sure?",2
  123.     dBUTTONS "No",%N,"Yes",%Y
  124.     RETURN UPPER$(chr$(DIALOG))="Y"
  125. ENDP
  126.  
  127. PROC DIRECT:(key%,mod%)
  128.   IF (mod% AND 2) AND anbool%=0
  129.     xan%=xcur% : yan%=ycur% : anbool%=1
  130.     IF viewwin$="View Off"
  131.         procV:
  132.     ENDIF
  133.   ENDIF
  134.  
  135.   If key%=256         REM UP
  136.       IF ycur%>1
  137.           ycur%=ycur%-4
  138.       ELSE
  139.           beep 4,600
  140.       ENDIF
  141.       IF ycur%<IABS(gORIGINY)
  142.           gSETWIN gORIGINX,gORIGINY+4
  143.       ENDIF
  144.   ENDIF    
  145.   
  146.   If key%=257         REM DOWN
  147.       IF ycur%<(h&*4)-3
  148.           ycur%=ycur%+4
  149.       ELSE
  150.           beep 4,600
  151.           RETURN
  152.       ENDIF
  153.       IF (ycur%-IABS(gORIGINY))>74
  154.           gSETWIN gORIGINX,GORIGINY-4
  155.       ENDIF
  156.   ENDIF    
  157.   
  158.   If key%=259         REM LEFT
  159.       IF xcur%>1
  160.           xcur%=xcur%-4
  161.       ELSE
  162.           beep 4,600
  163.       ENDIF
  164.       IF xcur%<IABS(gORIGINx)
  165.           gSETWIN gORIGINX+4,gORIGINY
  166.       ENDIF
  167.   ENDIF    
  168.   
  169.   If key%=258         REM RIGHT
  170.       IF xcur%<(w&*4)-3
  171.           xcur%=xcur%+4
  172.       ELSE
  173.           beep 4,600
  174.           RETURN
  175.       ENDIF
  176.       IF (xcur%-IABS(gORIGINx))>235
  177.           gSETWIN gORIGINX-4,GORIGINY
  178.       ENDIF
  179.   ENDIF    
  180.   IF anbool%=0
  181.       gAT xcur%,ycur%
  182.   ELSE
  183.     IF (mod% AND 2)=0
  184.         anbool%=0
  185.         gAT xcur%,ycur%            
  186.     ENDIF
  187.   endif
  188.   RETURN
  189.   
  190. ENDP
  191. PROC GETNAME$:(nam$)
  192.     local pos%,loc%,ext$(12)
  193.     pos%=len(nam$)+1
  194.     DO
  195.       pos%=pos%-1
  196.     UNTIL mid$(nam$,pos%,1)="\"
  197.     ext$=UPPER$(right$(nam$,len(nam$)-pos%))
  198.     loc%=loc(ext$,".")
  199.     if loc%
  200.             return left$(ext$,loc%-1)
  201.     else
  202.             return ext$
  203.     endif    
  204. ENDP
  205.  
  206. PROC Statup:
  207.     local x%,y%,pos$(8)
  208.     IF idmax%=0
  209.         beep 2,400 :GIPRINT "Load Bitmap First..."
  210.         RETURN
  211.     ENDIF
  212.     x% = (xcur%-1)/4 : y% = (ycur%-1)/4
  213.     pos$ = gen$(x%+1,3)+" "+gen$(y%+1,3)
  214.     
  215.     gUSE statwin%
  216.     gFONT 3: gAT 2,20 : gPrintb pos$,56,3   REM Current Position
  217.     gFONT 1: gAT 2,31 : gPrintb short$(idat%),56,3 REM Current File
  218.        gAT 2,43 : gPrintb "Wdth: "+gen$(w&,3),56,3
  219.        gAT 2,54 : gPrintb "Hght: "+gen$(h&,3),56,3
  220.     gAT 2,65 : gPRINTB "MAP "+gen$(idat%,1)+" of "+gen$(idmax%,1),56,3  rem using bitmap #/# of bitmaps
  221.     gUSE id%(idat%)
  222. ENDP
  223.  
  224. PROC procC:     REM Copy to Clipboard
  225.     local x1%,x2%,y1%,y2%,wid%,hgt%,temp%
  226.     IF anbool%=0
  227.         beep 2,400: gIPRINT "Highlight Something First..."
  228.         RETURN
  229.     ENDIF
  230.     BUSY "BUSY"
  231.     temp%=gIDENTITY
  232.     if clip%>0
  233.             gCLOSE clip%
  234.     endif
  235.     x1% =(xan%+3)/4 : x2%=(xcur%+3)/4
  236.     y1% =(yan%+3)/4 : y2%=(ycur%+3)/4
  237.     wid%=max((x2%-x1%+1),x1%-x2%+1)
  238.     hgt%=max((y2%-y1%+1),y1%-y2%+1)
  239.     clip%=gCREATE(0,0,wid%,hgt%,0)
  240.     gCOPY viewwin%(idat%),min(x1%,x2%),min(y1%,y2%),wid%,hgt%,3
  241.     gUSE temp%
  242.     BUSY OFF
  243.     giprint "Copied"
  244.     RETURN
  245. ENDP
  246.  
  247. PROC cut:     REM Cut to Clipboard
  248.     local x1%,x2%,y1%,y2%,wid%,hgt%,temp%
  249.     IF anbool%=0
  250.         beep 2,400: gIPRINT "Highlight Something First..."
  251.         RETURN
  252.     ENDIF
  253.     BUSY "BUSY"
  254.     temp%=gIDENTITY
  255.     if clip%>0
  256.             gCLOSE clip%
  257.     endif
  258.     x1% =(xan%+3)/4 : x2%=(xcur%+3)/4
  259.     y1% =(yan%+3)/4 : y2%=(ycur%+3)/4
  260.     wid%=max((x2%-x1%+1),x1%-x2%+1)
  261.     hgt%=max((y2%-y1%+1),y1%-y2%+1)
  262.     clip%=gCREATE(0,0,wid%,hgt%,0)
  263.     gCOPY viewwin%(idat%),min(x1%,x2%),min(y1%,y2%),wid%,hgt%,3
  264.     gUSE viewwin%(idat%)
  265.     gAT min(x1%,x2%),min(y1%,y2%)
  266.     gFILL wid%,hgt%,1
  267.     gUSE temp%
  268.     gAT min(xan%,xcur%),min(yan%,ycur%)
  269.     gFILL max((xcur%-xan%+4),xan%-xcur%+4),max((ycur%-yan%+4),yan%-ycur%+4),1
  270.     gAT xcur%,ycur%
  271.     anbool%=0
  272.     BUSY OFF
  273.     giprint "Cut"
  274.     RETURN
  275. ENDP
  276.  
  277.  
  278. PROC PROCB:     REM Filled Box
  279.     local x1%,x2%,y1%,y2%,wid%,hgt%,ch%
  280.     IF anbool%=0
  281.         beep 2,400: gIPRINT "Highlight Something First..."
  282.         RETURN
  283.     ENDIF
  284.     dINIT "Filled Box Choices"
  285.     dCHOICE ch%,"In Box, ","Set Bits,Clear Bits,Invert Bits"
  286.     IF dialog=0
  287.         RETURN
  288.     ENDIF
  289.     BUSY "BUSY"
  290.     x1% =(xan%+3)/4 : x2%=(xcur%+3)/4
  291.     y1% =(yan%+3)/4 : y2%=(ycur%+3)/4
  292.     wid%=max((x2%-x1%+1),x1%-x2%+1)
  293.     hgt%=max((y2%-y1%+1),y1%-y2%+1)
  294.     gUSE viewwin%(idat%)
  295.     gAT min(x1%,x2%),min(y1%,y2%)
  296.     gFILL wid%,hgt%,ch%-1
  297.     gUSE id%(idat%)
  298.     gAT min(xan%,xcur%),min(yan%,ycur%)
  299.     gFILL max((xcur%-xan%+4),xan%-xcur%+4),max((ycur%-yan%+4),yan%-ycur%+4),ch%-1
  300.     gAT xcur%,ycur%
  301.     anbo