!*! Updated on 03-Aug-90 at 3:55 PM by Steve Archuleta; edit time: 0:00:34
!
!
!  this program will be used for display purposes at a convention.
!
!

++INCLUDE DSK0:AMGSYM.BSI[7,6]  ! AMIGOS XCALL library

MAP1 CORNERX,F,6,0 !CORNER OF EACH SQUARE ON THE BOARD
MAP1 CORNERY,F,6,0

MAP1 BLACK,F,6,0 !ALL OF THE PRETTY COLORS WE CAN USE
MAP1 WHITE,F,6,1
MAP1 BLUE,F,6,2
MAP1 MAGENTA,F,6,3
MAP1 RED,F,6,4
MAP1 YELLOW,F,6,5
MAP1 GREEN,F,6,6
MAP1 CYAN,F,6,7
MAP1 GREY,F,6,9
MAP1 COLOR,F,6

MAP1 XLOCATION,F,6
MAP1 YLOCATION,F,6
MAP1 WORDS,S,25
MAP1 FONT,F,6

MAP1 GCB,X,80000 !GRAPHICS CONTROL BLOCK
MAP1 STATUS,F,6  !STATUS RETURN FROM GRAPHICS CALLS
MAP1 POINT'ARRAY
 MAP2 POINT'COUNT,B,2          ! total count of points
 MAP2 POINTS(25)               ! max number of points
   MAP3 X'POINT,B,2            ! X coordinate
   MAP3 Y'POINT,B,2            ! Y coordinate

MAP1 CIRCLE'ARRAY
 MAP2 CENT'X                   !CENTER OF CIRCLE TO DRAW
   MAP3 XCORD,B,2,8501         !X CORDNATE
   MAP3 YCORD,B,2,1500         !CAN YOU BELEVE IT, THE Y CORDNATE
 MAP2 RADIUS,B,2,1400          !THE ALL IMPORTANT RADIUS OF THE CIRCLE

MAP1 POIXTER,B,1           !CURRENT X POSITION OF THE POINTER ON BOARD
MAP1 POIYTER,B,1           !CURRENT Y POSITION OF THE POINTER ON BOARD

MAP1 BOARD                 !THIS IS THE BIG DATA STRUCTURE BABY
 MAP2 LOCATION(8,8),B,1   !0=NOTHING, 1=GREY, 2=BLACK
 MAP2 KING,B,1            !0=REGULAR MAN, 1=KING

!THIS IS THE START OF IT ALL AND THATS NO LIE


  ON ERROR GOTO EXIT      !LEAVE LIKE A NORMAL HUMAN
  PRINT TAB(-1,29);!TAB(-1,36);
  XCALL AMGSBR, G'OPWK, GCB,"", STATUS         ! OPEN THE WORKSTATION
  XCALL AMGSBR, G'CLRW, GCB, STATUS            ! CLEAR THE WORKSTATION
  CALL DRAW'BOARD
  CALL PLAC'CHECKRS
  CALL INIT'BOARD
  CALL PLAY
CLOSER: XCALL AMGSBR, G'CLWK, GCB, STATUS !CLOSE THE WORKSTATION NICELY
EXIT:   PRINT TAB(23,1); TAB(-1,37);:END  !LEAVE THIS MESS

DRAW'BOARD:
  !  draw checker board
  COLOR=WHITE
  XCALL AMGSBR, G'SFAS, GCB, 2, STATUS
  FOR CORNERX=4001 TO 28000 STEP 3000
     FOR CORNERY=1 TO 24000 STEP 3000
        X'POINT(1) = CORNERX
        Y'POINT(1) = CORNERY
        X'POINT(2) = CORNERX+3000    !MAX 32000 LOWER RIGHT-HAND CORNER
        Y'POINT(2) = CORNERY
        X'POINT(3) = CORNERX+3000    !MAX 32000 UPPER RIGHT-HAND CORNER HORIZONTAL
        Y'POINT(3) = CORNERY+3000    !MAX 24000 UPPER RIGHT-HAND CORNER VERTICAL
        X'POINT(4) = CORNERX
        Y'POINT(4) = CORNERY+3000
        X'POINT(5) = CORNERX
        Y'POINT(5) = CORNERY
        CALL RECT
        CALL CHG'COLR
     NEXT CORNERY
     CALL CHG'COLR
  NEXT CORNERX
  RETURN

PLAC'CHECKRS:!PUT DOWN SOME GREY CHECKERS DUDE
  COLOR=GREY
  XCORD=8501
  YCORD=1500
  RADIUS=1400
  FOR COUNTER=1 TO 4
     CALL CIRCLE
     XCORD=XCORD+6000
  NEXT COUNTER
  XCORD=23501
  YCORD=4500
  FOR COUNTER=1 TO 4
     CALL CIRCLE
     XCORD=XCORD-6000
  NEXT COUNTER
  XCORD=8501
  YCORD=7500
  FOR COUNTER=1 TO 4
     CALL CIRCLE
     XCORD=XCORD+6000
  NEXT COUNTER

!NOW LETS LAY DOWN A FEW BLACK CHECKERS AND GET ON WITH THE GAME

  COLOR=BLACK
  XCORD=5501
  YCORD=16500
  FOR COUNTER=1 TO 4
    CALL CIRCLE
    XCORD=XCORD+6000
  NEXT COUNTER
  XCORD=26501
  YCORD=19500
  FOR COUNTER=1 TO 4
     CALL CIRCLE
     XCORD=XCORD-6000
  NEXT COUNTER
  XCORD=5501
  YCORD=22500
  FOR COUNTER=1 TO 4
     CALL CIRCLE
     XCORD=XCORD+6000
  NEXT COUNTER
  POIXTER=5
  POIYTER=4
  CALL MARK
  RETURN

PLAY:
  XCALL INKEY,INSTR
  IF INSTR="1" THEN CALL ONE
!  IF INSTR="2" THEN CALL TWO
!  IF INSTR="3" THEN CALL THREE
!  IF INSTR="4" THEN CALL FOUR
!  IF INSTR="6" THEN CALL SIX
!  IF INSTR="7" THEN CALL SEVEN
!  IF INSTR="8" THEN CALL EIGHT
!  IF INSTR="9" THEN CALL NINE
!  IF INSTR="J" THEN CALL JUMP
!  IF INSTR="N" THEN CALL NEW
  IF INSTR="Q" THEN CALL QUIT
!  IF INSTR="?" THEN CALL HELP
  GOTO PLAY

MARK:
  CENTX=5501+(POIXTER-1)*3000
  CENTY=1501+(POIYTER-1)*3000
  COLOR=BLUE
  XCALL AMGSBR,G'GCIR,GCB,CENTX-1475,CENTY+1475,20,125,STATUS
  XCALL AMGSBR,G'GCIR,GCB,CENTX+1475,CENTY+1475,20,125,STATUS
  XCALL AMGSBR,G'GCIR,GCB,CENTX+1475,CENTY-1475,20,125,STATUS
  XCALL AMGSBR,G'GCIR,GCB,CENTX-1475,CENTY-1475,20,125,STATUS
  RETURN

XMARK:
  CENTX=5501+(POIXTER-1)*3000
  CENTY=1501+(POIYTER-1)*3000
  COLOR=RED
  XCALL AMGSBR,G'GCIR,GCB,CENTX-1475,CENTY+1475,20,125,STATUS
  XCALL AMGSBR,G'GCIR,GCB,CENTX+1475,CENTY+1475,20,125,STATUS
  XCALL AMGSBR,G'GCIR,GCB,CENTX+1475,CENTY-1475,20,125,STATUS
  XCALL AMGSBR,G'GCIR,GCB,CENTX-1475,CENTY-1475,20,125,STATUS
  RETURN

ONE:
  CALL XMARK
  POIXTER=POIXTER-1
  IF POIXTER=0 THEN POIXTER=8
  POIYTER=POIYTER-1
  IF POIYTER=0 THEN POIYTER=8
  CALL MARK
  RETURN

QUIT:
  RETURN

RECT:!THIS ROUTINE WILL DRAW ALL OF THE LITTLE SQUARES ON THE SCREEN
  XCALL AMGSBR, G'SFAC, GCB, COLOR,STATUS
  POINT'COUNT = 5
  XCALL AMGSBR, G'FA, GCB, POINT'ARRAY, STATUS
  IF NO'OUTLINE=1 THEN NO'OUTLINE=0 : RETURN
  ! outline the right face
  XCALL AMGSBR, G'SPLC, GCB,BLACK, STATUS              ! fill style
  XCALL AMGSBR, G'PL, GCB, POINT'ARRAY, STATUS
  RETURN

CHG'COLR: !ALTERNATE THE COLOR OF THE SQUARES
  IF COLOR=RED THEN COLOR=WHITE ELSE COLOR=RED
  RETURN

CIRCLE:!LETS DRAW SOME CIRCLES OK
  XCALL AMGSBR,G'SFAS,GCB,2,STATUS
  XCALL AMGSBR,G'SFAC,GCB,COLOR,STATUS
  XCALL AMGSBR,G'GCIR,GCB,XCORD,YCORD,RADIUS,125,STATUS
  RETURN

INIT'BOARD:
  YCOUNT=1
  FOR XCOUNT=2 TO 8 STEP 2
     LOCATION(XCOUNT,YCOUNT)=1
  NEXT XCOUNT
  YCOUNT=2
  FOR XCOUNT=1 TO 7 STEP 2
     LOCATION(XCOUNT,YCOUNT)=1
  NEXT XCOUNT
  YCOUNT=3
  FOR XCOUNT=2 TO 8 STEP 2
     LOCATION(XCOUNT,YCOUNT)=1
  NEXT XCOUNT
  YCOUNT=6
  FOR XCOUNT=1 TO 7 STEP 2
     LOCATION(XCOUNT,YCOUNT)=2
  NEXT XCOUNT
  YCOUNT=7
  FOR XCOUNT=2 TO 8 STEP 2
     LOCATION(XCOUNT,YCOUNT)=2
  NEXT XCOUNT
  YCOUNT=8
  FOR XCOUNT=1 TO 7 STEP 2
     LOCATION(XCOUNT,YCOUNT)=2
  NEXT XCOUNT
  FOR XCOUNT=1 TO 8
     FOR YCOUNT=4 TO 5
        LOCATION(XCOUNT,YCOUNT)=0
     NEXT YCOUNT
  NEXT XCOUNT
  RETURN

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.