home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / games / go / go.opl < prev    next >
Text File  |  1995-03-16  |  14KB  |  837 lines
  1. REM GO EDITOR using John Hind's application framework
  2. REM Copyright (C) 1993 John Tromp
  3.  
  4. APP Go
  5.     TYPE 3
  6.     PATH "\GO"
  7.     EXT "GO"
  8.     ICON "\GO\Go.ico"
  9. ENDA
  10.  
  11. PROC Go:
  12.     GLOBAL bw%,bh%,bs%    REM board width,height,size
  13.     GLOBAL gb%                    REM go board, stone bitmap
  14.     GLOBAL eb%,db%            REM empty/dot bitmaps
  15.     GLOBAL sr%,sd%,nd%    REM stone radius/diameter, neighbour distance
  16.     GLOBAL bwp%,bhp%        REM board width/height in pixels
  17.     GLOBAL maxnv%                REM max # non-visible pixels
  18.     GLOBAL mv%(512),mn% REM moves, move number
  19.     GLOBAL bd%(880)            REM board data sets
  20.     GLOBAL cx%,cy%            REM cursor x/y
  21.     GLOBAL pt%(440)            REM point type
  22.     GLOBAL uf%(440)            REM union find
  23.     GLOBAL log%(4096)        REM union/find log
  24.     GLOBAL clix%                REM log index
  25.     GLOBAL ogb%,osb%        REM overview go board/stones
  26.     GLOBAL obwp%,obhp%    REM overview board width/height
  27.     GLOBAL komi                    REM 2nd move compensation
  28.     GLOBAL name$(128)        REM file name
  29.     GLOBAL changed%            REM remember to save
  30.     GLOBAL ten%                    REM prepare for rank>=10
  31.     GLOBAL ko%(512)            REM forbidden moves
  32.     LOCAL x%,y%
  33.  
  34.     db%=gCREATEBIT(4,4)
  35.     gCLS
  36.     gAT 1,1 :gLINEBY 1,0
  37.     osb%=gCREATEBIT(15,5)
  38.     gCLS :gAT 2,2 :gLINEBY 1,0
  39.     gAT 5,0 :gINVERT 5,5
  40.     gAT 10,0 :gINVERT 5,5
  41.     gAT 11,1 :gFILL 3,3,1
  42.     komi=5.5
  43.     log%(1)=0
  44.     x%=22 :y%=22
  45.     pt%(x%)=3
  46.     pt%(x%-21)=-1 :pt%(y%-1)=-1
  47.     DO
  48.         x%=x%+1 :y%=y%+21
  49.         pt%(x%-21)=-1 :pt%(y%-1)=-1
  50.         pt%(x%)=4 :pt%(y%)=6
  51.     UNTIL x%=41
  52.     sr%=3 :maxnv%=15
  53.     bw%=9 :bh%=9
  54.     newstns:
  55.     
  56.  LOADM "\OPO\FRAMELIB.OPO"            REM Load the Application Framework code
  57.  fAutoOff:                                            REM Allow automatic switch-off
  58.  fRun:($330,"LSBEPNDTOKRCX",0)    REM Run application
  59. ENDP
  60.  
  61. PROC aHkX%:        REM Callback to exit application on PSION-X
  62.  RETURN 100        REM "Exit from application" message
  63. ENDP
  64.  
  65. PROC aMh5%:        REM Callback for "Printable key pressed" message
  66.     IF fParm%=32
  67.         forward%:
  68.         RETURN 0
  69.     ENDIF
  70.     IF fParm%=49 AND bh%>=10
  71.         torow:(ten%+1)
  72.         ten%=10-ten%
  73.     ELSEIF fParm% >= 48 AND fParm% < 58
  74.         torow:(ten%+fParm%-48)
  75.         ten%=0
  76.     ELSE
  77.         fParm%=fParm% AND $FFDF
  78.         IF fParm%>=%A AND fParm%<=%T
  79.             tocol:(fParm%-%A-(fParm%<%J))
  80.             ten%=0
  81.         ELSE
  82.             BEEP 2,300
  83.         ENDIF
  84.     ENDIF
  85.     RETURN 0
  86. ENDP
  87.  
  88. PROC aMh6%:        REM Callback for "Special key pressed" message
  89.     IF fParm%=$100 :up:
  90.     ELSEIF fParm%=$101 :down:
  91.     ELSEIF fParm%=$102 :right:
  92.     ELSEIF fParm%=$103 :left:
  93.     ELSEIF fParm%=8  :back:
  94.     ELSEIF fParm%=13 :move:
  95.     ELSE BEEP 2,300
  96.     ENDIF
  97.     RETURN 0
  98. ENDP
  99.  
  100. PROC aMh9%:        REM Callback for "Menu key pressed" message
  101.     LOCAL k%
  102.  
  103.     mINIT
  104.     mCARD "File","Load",%L,"Save as",%S
  105.     mCARD "Play","Begin",%B,"End",%E,"Pass",%P,"Notate",%N
  106.     mCARD "Display","Dimensions",%D,"Scrolling",%T,"Overview",%O
  107.     mCARD "Special","Komi",%K,"Remove",%R,"Count",%C,"Exit",%x
  108.     k%=fMenu%:                          REM Show menu (NOTE: bug fixed version of MENU)
  109.     IF k%=0                REM Menu aborted by user
  110.         RETURN 0        REM Return null command
  111.     ELSE
  112.         fParm%=k%        REM Parameter for "Hotkey pressed" message
  113.         RETURN 4        REM "Hotkey pressed" message
  114.     ENDIF
  115. ENDP
  116.  
  117. PROC aMh10%:        REM Callback for "Help key pressed" message
  118.     dINIT "Help: Go Editor"
  119.     dTEXT "","Use cursor keys to move"
  120.     dTEXT "","or type the coordinates"
  121.     dTEXT "","Shift increases cursor movement"
  122.     dTEXT "","Enter to place stone"
  123.     dTEXT "","Delete/Space to go back/forward"
  124.     fLock:
  125.     DIALOG
  126.     fUnlock:
  127.     RETURN 0
  128. ENDP
  129.  
  130. PROC aHkN%:
  131.     GIPRINT CHR$(cx%+%A+(cx%<10))+GEN$(bh%+1-cy%,2)
  132.     RETURN 0
  133. ENDP
  134.  
  135. PROC aHkK%:
  136.     dINIT "Set komi"
  137.     dFLOAT komi,"Komi:",0,256
  138.     fLock:
  139.     DIALOG
  140.     fUnlock:
  141.     RETURN 0
  142. ENDP REM setkomi
  143.  
  144. PROC aHkC%:
  145.     LOCAL p%,s%,ws
  146.     GLOBAL wc%,bc%
  147.     GIPRINT "Counting..."
  148.     p%=pos%:(bw%,bh%)
  149.     DO
  150.         s%=bd%(p%)
  151.         IF s%=0 :s%=4 :ENDIF
  152.         bd%(p%+440)=s%
  153.         p%=p%-1
  154.     UNTIL p%<21
  155.     p%=pos%:(bw%,bh%)
  156.     DO
  157.         DO
  158.             s%=bd%(p%+440)
  159.             IF s%=4
  160.                 s%=whose%:(p%)
  161.                 IF s%=1 OR s%=2
  162.                     assign:(p%,s%)
  163.                 ENDIF
  164.             ENDIF
  165.             IF s%=1
  166.                 bc%=bc%+1
  167.             ELSEIF s%=2
  168.                 wc%=wc%+1
  169.             ENDIF
  170.             p%=p%-1
  171.         UNTIL pt%(p%)=-1
  172.         p%=p%+bw%-20
  173.     UNTIL p%<21
  174.     overvw:(440)
  175.     ws=wc%+komi
  176.     dINIT "Score"
  177.     dTEXT "White:",GEN$(ws,5)
  178.     dTEXT "Black:",GEN$(bc%,5)
  179.     IF ws>bc%
  180.         dTEXT "","White wins"
  181.     ELSEIF bc%>ws
  182.         dTEXT "","Black wins"
  183.     ELSE dTEXT "","Jigo"
  184.     ENDIF
  185.     fLock:
  186.     DIALOG
  187.     fUnlock:
  188.     RETURN 0
  189. ENDP REM count
  190.  
  191. PROC torow:(r%)
  192.     IF r%>=1 AND r%<=bh%
  193.         cy%=bh%+1-r%
  194.         mvcur:
  195.     ENDIF
  196. ENDP
  197.  
  198. PROC tocol:(c%)
  199.     IF c%>=1 AND c%<=bw%
  200.         cx%=c%
  201.         mvcur:
  202.     ENDIF
  203. ENDP
  204.  
  205. PROC whose%:(p%)
  206.     LOCAL s%
  207.     IF pt%(p%)=-1 :RETURN 0 :ENDIF
  208.     s%=bd%(p%+440)
  209.     IF s%<4 :RETURN s% :ENDIF
  210.     bd%(p%+440)=0
  211.     RETURN whose%:(p%-21) OR whose%:(p%+1) OR whose%:(p%+21) OR whose%:(p%-1)
  212. ENDP REM whose
  213.  
  214. PROC assign:(p%,s%)
  215.     IF pt%(p%)=-1 OR bd%(p%+440) :RETURN :ENDIF
  216.     bd%(p%+440)=s%
  217.     assign:(p%-21,s%)
  218.     assign:(p%+1,s%)
  219.     assign:(p%+21,s%)
  220.     assign:(p%-1,s%)
  221. ENDP REM assign
  222.  
  223. PROC aHkL%:
  224.     LOCAL ret%
  225.     name$="\GO\*.go"
  226.     dINIT "Load file"
  227.     dFILE name$,"File:",0
  228.     fLock:
  229.     ret%=DIALOG
  230.     fUnlock:
  231.     IF ret%=0 :RETURN 0 :ENDIF
  232.     fParm$=name$
  233.     RETURN 102
  234. ENDP
  235.  
  236. PROC aOpen%:        REM Callback for file opening
  237.     LOCAL ret%,fh%,x%,y%
  238.  
  239.     name$=fParm$
  240.     ret%=IOOPEN(fh%,name$,0)
  241.     IF ret%<0
  242.         GIPRINT ERR$(ret%)
  243.         RETURN -3
  244.     ENDIF
  245.     ret%=IOREAD(fh%,ADDR(mv%()),2)
  246.     x%=PEEKB(ADDR(mv%()))
  247.     y%=PEEKB(ADDR(mv%())+1)
  248.     IF x%<2 OR x%>19 OR y%<2 OR y%>19
  249.         GIPRINT "Illegal board size"
  250.         IOCLOSE(fh%)
  251.         RETURN -3
  252.     ENDIF
  253.     resize:(x%,y%)
  254.     ret%=IOREAD(fh%,ADDR(mv%()),1024)
  255.     IF ret%=-36
  256.         ret%=0 :REM premature eof (bug)
  257.     ENDIF
  258.     GIPRINT GEN$(ret%/2,3)+" moves read"
  259.     IOCLOSE(fh%)
  260.     changed%=0
  261.     RETURN 0
  262. ENDP
  263.  
  264. PROC aCreate%:        REM Callback for file creation
  265.  name$=fParm$
  266.  changed%=1
  267.  aHkD%:
  268.  RETURN 0
  269. ENDP
  270.  
  271. PROC aClose%:        REM Calback for file closing
  272.     LOCAL ret%
  273.  
  274.     IF changed%
  275.         fLock:
  276.         ret%=ALERT("Save changes?","","No","Yes")
  277.         fUnlock:
  278.         IF ret%=2
  279.              aHkS%:
  280.         ENDIF
  281.     ENDIF
  282.     RETURN 0
  283. ENDP
  284.  
  285. PROC aHkS%:
  286.     LOCAL bytes%,m%,i&,fh%
  287.     m%=0
  288.     WHILE mv%(m%+1) :m%=m%+1 :ENDWH
  289.     i&=mn%
  290.     dINIT "Save file"
  291.     dFILE name$,"Name:",17
  292.     dLONG i&,"Moves:",0,m%
  293.     fLock:
  294.     m%=DIALOG
  295.     fUnlock:
  296.     IF m%=0
  297.         GIPRINT "Not saved"
  298.         RETURN 0
  299.     ENDIF
  300.     IF UPPER$(RIGHT$(name$,3))<>".GO"
  301.         name$=name$+".go"
  302.     ENDIF
  303.     m%=IOOPEN(fh%,name$,$102)
  304.     IF m%<0
  305.         GIPRINT ERR$(m%)
  306.         RETURN -1
  307.     ENDIF
  308.     bytes%=256*bh%+bw%
  309.     IOWRITE(fh%,ADDR(bytes%),2)
  310.     bytes%=2*i&
  311.     m%=IOWRITE(fh%,ADDR(mv%()),bytes%)
  312.     IF m%<0
  313.         GIPRINT ERR$(m%)
  314.         RETURN -1
  315.     ENDIF
  316.     GIPRINT "Game saved"
  317.     changed%=0
  318.     IOCLOSE(fh%)
  319.     RETURN 0
  320. ENDP REM save
  321.  
  322. PROC aHkO%:
  323.     overvw:(0)
  324.     RETURN 0
  325. ENDP
  326.  
  327. PROC overvw:(off%)
  328.     LOCAL dx%,y%,p%,s%
  329.     gUSE ogb%
  330.     gCLS
  331.     y%=1
  332.     DO
  333.         dx%=0 :gAT 0,4*(y%-1)
  334.         p%=pos%:(1,y%)
  335.         DO
  336.             s%=5*bd%(p%+dx%+off%)
  337.             gCOPY osb%,s%,0,5,5,0
  338.             dx%=dx%+1 :gMOVE 4,0
  339.         UNTIL dx%=bw%
  340.     y%=y%+1
  341.     UNTIL y%>bh%
  342.     gUSE gb%
  343. ENDP REM overvw
  344.  
  345. PROC aHkB%:
  346.     emptybrd:(0)
  347.     drawbrd:
  348.     RETURN 0
  349. ENDP REM start
  350.  
  351. PROC emptybrd:(off%)
  352.     LOCAL i%
  353.     i%=1
  354.     DO
  355.         bd%(i%+off%)=0
  356.         i%=i%+1
  357.     UNTIL i%>440
  358.     clix%=1 :mn%=0
  359. ENDP REM emptybrd
  360.  
  361. PROC up:
  362.     IF cy%>1
  363.         IF fKmod% AND 2
  364.             cy%=MAX(cy%-6,1)
  365.         ELSE
  366.             cy%=cy%-1
  367.         ENDIF
  368.         mvcur:
  369.     ENDIF
  370. ENDP REM up
  371.  
  372. PROC down:
  373.     IF cy%<bh%
  374.         IF fKmod% AND 2
  375.             cy%=MIN(cy%+6,bh%)
  376.         ELSE
  377.             cy%=cy%+1
  378.         ENDIF
  379.         mvcur:
  380.     ENDIF
  381. ENDP REM down
  382.  
  383. PROC right:
  384.     IF cx%<bw%
  385.         IF fKmod% AND 2
  386.             cx%=MIN(cx%+6,bw%)
  387.             curret:
  388.         ELSE
  389.             cx%=cx%+1
  390.             gMOVE nd%,0
  391.         ENDIF
  392.     ENDIF
  393. ENDP REM right
  394.  
  395. PROC left:
  396.     IF cx%>1
  397.         IF fKmod% AND 2
  398.             cx%=MAX(cx%-6,1)
  399.             curret:
  400.         ELSE
  401.             cx%=cx%-1
  402.             gMOVE -nd%,0
  403.         ENDIF
  404.     ENDIF
  405. ENDP REM left
  406.  
  407. PROC move:
  408.     GLOBAL root%
  409.     LOCAL p%,s%,ret%,cap%
  410.     p%=pos%:(cx%,cy%)
  411.     IF bd%(p%) OR p%=ko%(mn%+1)
  412.         BEEP 9,100
  413.         RETURN
  414.     ENDIF
  415.     IF fParm%=13
  416.         changed%=1
  417.     ENDIF
  418.     mn%=mn%+1
  419.     s%=2-(mn% AND 1)
  420.     play:(cx%,cy%,s%)
  421.     root%=p% :ufset:(root%,0)
  422.     ko%(mn%+1)=0
  423.     cap%=neighbr%:(p%-21,cx%,cy%-1,s%)+2*neighbr%:(p%+1,cx%+1,cy%,s%)+4*neighbr%:(p%+21,cx%,cy%+1,s%)+8*neighbr%:(p%-1,cx%-1,cy%,s%)
  424.     IF uf%(root%)=0
  425.         capture%:(cx%,cy%,s%)
  426.         cap%=16
  427.     ENDIF
  428.     mv%(mn%)=cx%+256*cy%
  429.     clix%=clix%+1
  430.     log%(clix%)=cap%
  431.     curret:
  432. ENDP REM move
  433.  
  434. PROC neighbr%:(p%,x%,y%,s%)
  435.     LOCAL ns%,nr%
  436.     IF pt%(p%)=-1 :RETURN 0: ENDIF
  437.     ns%=bd%(p%)
  438.     IF ns%=0
  439.         ufset:(root%,uf%(root%)-1) REM add liberty
  440.         ko%(mn%+1)=-1
  441.         RETURN 0
  442.     ENDIF
  443.     nr%=p%
  444.     WHILE uf%(nr%)>0
  445.         nr%=uf%(nr%)
  446.     ENDWH
  447.     IF ns%=s%
  448.         IF nr%=root%
  449.             ufset:(nr%,uf%(nr%)+1)
  450.         ELSE
  451.             ns%=uf%(root%)+uf%(nr%)+1
  452.             IF uf%(root%) < uf%(nr%)
  453.                 ufset:(root%,ns%)
  454.                 ufset:(nr%,root%)
  455.             ELSE
  456.                 ufset:(nr%,ns%)
  457.                 ufset:(root%,nr%)
  458.                 root%=nr%
  459.             ENDIF
  460.         ENDIF
  461.         ko%(mn%+1)=-1
  462.         RETURN 0
  463.     ENDIF
  464.     IF uf%(nr%)=-1
  465.       IF ca