(*********************************************************************
  :Program.    MasterMind.mod
  :Contents.   the game, I suppose, anyone knows
  :Author.     Thomas Berndt
  :Copyright.  PD
  :Language.   Modula-2
  :Translator. M2Amiga AMSoft V3.3d
  :History.    02-91 Thomas Berndt
  :Address.    Neckarhauserstr. 94 6800 Mannheim-71
  :Imports.    BeamRandom AMOK#20
*********************************************************************)

MODULE MasterMind ;
(* $V- $S-  $F- $P- $R- *)
FROM Arts       IMPORT AllLevelTermProc ;
FROM BeamRandom IMPORT RND ;
FROM Exec       IMPORT WaitPort,GetMsg,ReplyMsg ;
FROM Graphics   IMPORT ViewModes,ViewModeSet,DrawModes,DrawModeSet,
                       RastPortPtr,Move,Draw,Text,SetAPen,SetBPen,
                       RectFill,DrawEllipse,SetRGB4,SetRast ;
FROM Intuition  IMPORT NewScreen,ScreenPtr,ScreenFlags,ScreenFlagSet,
                       customScreen,OpenScreen,CloseScreen,
                       NewWindow,WindowPtr,WindowFlags,WindowFlagSet,
                       OpenWindow,CloseWindow,IDCMPFlags,IDCMPFlagSet,
                       IntuiMessagePtr,Gadget,GadgetFlags,GadgetFlagSet,
                       ActivationFlags,ActivationFlagSet ;
FROM SYSTEM     IMPORT ADR,ADDRESS ;

TYPE
  Code                  = ARRAY [0..6] OF INTEGER ;

VAR
  Scr                   : ScreenPtr ;
  Win                   : WindowPtr ;
  rpp                   : RastPortPtr ;
  Msg                   : IntuiMessagePtr ;
  Class                 : IDCMPFlagSet ;
  Addr                  : ADDRESS ;
  OKGad,ShowGad,EndGad  : Gadget ;
  lap,color,PosOK,ColOK,
  x,y,i,j               : INTEGER ;
  Combination,Copy,
  Player                : Code ;
  closed                : BOOLEAN ;

PROCEDURE Close ;
BEGIN
  IF Win#NIL THEN
    CloseWindow(Win) ;
  END ; (* IF *)
  IF Scr#NIL THEN
    CloseScreen(Scr) ;
  END ; (* IF *)
END Close ;

PROCEDURE Box(x1,y1,x2,y2 : INTEGER) ;
BEGIN
  Move(rpp,x1,y1) ;
  Draw(rpp,x2,y1) ;
  Draw(rpp,x2,y2) ;
  Draw(rpp,x1,y2) ;
  Draw(rpp,x1,y1) ;
END Box ;

PROCEDURE Build ;
VAR
  NuScr         : NewScreen ;
  NuWin         : NewWindow ;
BEGIN
  WITH NuScr DO
    leftEdge  := 0     ; topEdge  := 0 ;
    width     := 320   ; height   := 256 ;
    depth     := 4     ; detailPen := 0 ;
    blockPen  := 1     ; viewModes := ViewModeSet{} ;
    type      := customScreen ;
    font      := NIL ;
    defaultTitle := ADR("MasterMind") ;
    gadgets := NIL     ; customBitMap := NIL ;
  END ; (* WITH *)
  Scr := OpenScreen(NuScr) ;
  WITH OKGad DO
    nextGadget := ADR(ShowGad) ;
    leftEdge := 193 ;
    topEdge := 176 ;
    width := 31 ;
    height := 11 ;
    flags := GadgetFlagSet{} ;
    activation := ActivationFlagSet{relVerify,gadgImmediate} ;
    gadgetType := 1 ;
    gadgetRender := NIL ;
    selectRender := NIL ;
    gadgetText := NIL ;
  END ; (* WITH *)
  WITH ShowGad DO
    nextGadget := ADR(EndGad) ;
    leftEdge := 241 ;
    topEdge := 176 ;
    width := 55 ;
    height := 11 ;
    flags := GadgetFlagSet{} ;
    activation := ActivationFlagSet{relVerify,gadgImmediate} ;
    gadgetType := 1 ;
    gadgetRender := NIL ;
    selectRender := NIL ;
    gadgetText := NIL ;
  END ; (* WITH *)
  WITH EndGad DO
    nextGadget := NIL ;
    leftEdge := 220 ;
    topEdge := 198 ;
    width := 47 ;
    height := 11 ;
    flags := GadgetFlagSet{} ;
    activation := ActivationFlagSet{relVerify,gadgImmediate} ;
    gadgetType := 1 ;
    gadgetRender := NIL ;
    selectRender := NIL ;
    gadgetText := NIL ;
  END ; (* WITH *)
  WITH NuWin DO
    leftEdge    := 0     ; topEdge := 11 ;
    width       := 320    ; height := 245 ;
    detailPen   := 0      ; blockPen := 1 ;
    idcmpFlags  := IDCMPFlagSet{mouseButtons,gadgetUp} ;
    flags       := WindowFlagSet{borderless} ;
    firstGadget := ADR(OKGad) ;
    checkMark := NIL ;
    title       := NIL ;
    screen      := Scr ;
    bitMap      := NIL    ; type := customScreen ;
    minWidth   := 100     ; maxWidth := 320 ;
    minHeight  := 20      ; maxHeight := 245 ;
  END ; (* WITH *)
  Win := OpenWindow(NuWin) ;
  rpp := Win^.rPort ;
  SetRGB4(ADR(Scr^.viewPort),0,3,7,6) ;    (* blau-grün *)
  SetRGB4(ADR(Scr^.viewPort),2,6,4,13) ;   (* blau *)
  SetRGB4(ADR(Scr^.viewPort),3,15,0,0) ;   (* rot *)
  SetRGB4(ADR(Scr^.viewPort),4,2,13,3) ;   (* grün *)
  SetRGB4(ADR(Scr^.viewPort),5,12,8,0) ;   (* braun *)
  SetRGB4(ADR(Scr^.viewPort),6,12,1,15) ;  (* lila *)
  SetRGB4(ADR(Scr^.viewPort),7,15,15,0) ;  (* gelb *)
  SetAPen(rpp,1) ;
  Box(5,20,160,160) ;
  Box(30,30,50,150) ;
  Box(29,29,51,151) ;
  Move(rpp,40,30) ;
  Draw(rpp,40,150) ;
  Box(60,30,140,150) ;
  Box(59,29,141,151) ;
  FOR i := 0 TO 5 DO
    Move(rpp,30,30+i*20) ;
    Draw(rpp,50,30+i*20) ;
    Move(rpp,30,29+i*20) ;
    Draw(rpp,50,29+i*20) ;
    Move(rpp,30,40+i*20) ;
    Draw(rpp,50,40+i*20) ;
    Move(rpp,60,30+i*20) ;
    Draw(rpp,140,30+i*20) ;
    Move(rpp,60,29+i*20) ;
    Draw(rpp,140,29+i*20) ;
    Move(rpp,5+i*25,190) ;
    Draw(rpp,5+i*25,210) ;
    SetAPen(rpp,2+i) ;
    RectFill(rpp,7+i*25,192,28+i*25,208) ;
    SetAPen(rpp,1) ;
  END ; (* FOR *)
  FOR i := 0 TO 3 DO
    DrawEllipse(rpp,210+i*20,120,7,7) ;
    Move(rpp,200+i*20,110) ;
    Draw(rpp,200+i*20,130) ;
    Move(rpp,60+i*20,30) ;
    Draw(rpp,60+i*20,150) ;
    FOR j := 0 TO 5 DO
      DrawEllipse(rpp,70+i*20,40+j*20,7,7) ;
    END ; (* FOR *)
  END ; (* FOR *)
  Move(rpp,56,184) ;
  Text(rpp,ADR("Farben"),6) ;
  Box(5,190,155,210) ;
  Move(rpp,200,48) ;
  Text(rpp,ADR("MasterMind"),10) ;
  Move(rpp,184,64) ;
  Text(rpp,ADR("von Th. Berndt"),14) ;
  Move(rpp,196,96) ;
  Text(rpp,ADR("Kombination"),11) ;
  Box(200,110,280,130) ;
  Move(rpp,200,184) ;
  Text(rpp,ADR("OK"),2) ;
  Box(192,175,224,187) ;
  Move(rpp,248,184) ;
  Text(rpp,ADR("Zeige"),5) ;
  Box(240,175,296,187) ;
  Move(rpp,228,206) ;
  Text(rpp,ADR("Ende"),4) ;
  Box(219,197,267,209) ;
END Build ;

PROCEDURE Clear ;
BEGIN
  SetAPen(rpp,0) ;
  RectFill(rpp,31,31,49,149) ;
  SetAPen(rpp,1) ;
  Move(rpp,40,30) ;
  Draw(rpp,40,150) ;
  FOR i := 0 TO 5 DO
    SetAPen(rpp,0) ;
    RectFill(rpp,61,31+i*20,139,48+i*20) ;
    FOR j := 0 TO 3 DO
      SetAPen(rpp,1) ;
      DrawEllipse(rpp,70+j*20,40+i*20,7,7) ;
      Move(rpp,60+j*20,30+i*20) ;
      Draw(rpp,60+j*20,49+i*20) ;
      SetAPen(rpp,0) ;
      DrawEllipse(rpp,210+j*20,120,5,i) ;
    END ; (* FOR *)
    SetAPen(rpp,1) ;
    Move(rpp,30,30+i*20) ;
    Draw(rpp,50,30+i*20) ;
    Move(rpp,30,29+i*20) ;
    Draw(rpp,50,29+i*20) ;
    Move(rpp,30,40+i*20) ;
    Draw(rpp,50,40+i*20) ;
  END ; (* FOR *)
END Clear ;

PROCEDURE Show ;
BEGIN
  FOR i := 0 TO 3 DO
    SetAPen(rpp,Combination[i]+2) ;
    FOR j := 0 TO 5 DO
      DrawEllipse(rpp,210+i*20,120,5,j) ;
    END ; (* FOR *)
  END ; (* FOR *)
  REPEAT
    WaitPort(Win^.userPort) ;
    Msg := GetMsg(Win^.userPort) ;
    Class := Msg^.class ;
    Addr := Msg^.iAddress ;
    ReplyMsg(Msg) ;
  UNTIL Addr=ADR(OKGad) ;
END Show ;

PROCEDURE Ziehe ;
BEGIN
  FOR i := 0 TO 3 DO
    Combination[i] := RND(6) ;
    j := 0 ;
    WHILE j<i DO
      IF Combination[i]=Combination[j] THEN
        Combination[i] := RND(6) ;
        j := 0 ;
      ELSE
        INC(j) ;
      END ; (* IF *)
    END ; (* WHILE *)
  END ; (* FOR *)
END Ziehe ;

PROCEDURE Check ;
BEGIN
  Copy := Combination ;
  PosOK := 0 ;
  ColOK := 0 ;
  FOR i := 0 TO 3 DO
    IF Copy[i]=Player[i] THEN
      INC(PosOK) ;
      Copy[i] := -1 ;
      Player[i] := -2 ;
    END ; (* IF *)
  END ; (* FOR *)
  SetAPen(rpp,8) ;
  FOR i := 0 TO PosOK-1 DO
    IF i<2 THEN
      FOR j := 0 TO 3 DO
        DrawEllipse(rpp,35+i*10,35+lap*20,3,j) ;
      END ; (* FOR *)
    ELSE
      FOR j := 0 TO 3 DO
        DrawEllipse(rpp,35+(i-2)*10,45+lap*20,3,j) ;
      END ; (* FOR *)
    END ; (* IF *)
  END ; (* FOR *)
  IF PosOK#4 THEN
    FOR i := 0 TO 3 DO
      FOR j := 0 TO 3 DO
        IF Copy[i]=Player[j] THEN
          INC(ColOK) ;
        END ; (* IF *)
      END ; (* FOR *)
    END ; (* FOR *)
    SetAPen(rpp,1) ;
    FOR i := PosOK TO PosOK+ColOK-1 DO
      IF i<2 THEN
        FOR j := 0 TO 3 DO
          DrawEllipse(rpp,35+i*10,35+lap*20,3,j) ;
        END ; (* FOR *)
      ELSE
        FOR j := 0 TO 3 DO
          DrawEllipse(rpp,35+(i-2)*10,45+lap*20,3,j) ;
        END ; (* FOR *)
      END ; (* IF *)
    END ; (* FOR *)
    SetAPen(rpp,color) ;
  ELSE
    lap := 6 ;
    Show ;
  END ; (* IF *)
  FOR i := 0 TO 3 DO
    Player[i] := -1 ;
  END ; (* FOR *)
END Check ;

PROCEDURE SetColor ;
BEGIN
  x := Win^.mouseX ;
  y := Win^.mouseY ;
  IF (y>lap*20+30) AND (y<lap*20+50) THEN
    FOR i := 0 TO 3 DO
      IF (x>60+i*20) AND (x<80+i*20) THEN
        FOR j := 0 TO 5 DO
          DrawEllipse(rpp,70+i*20,40+lap*20,j,5) ;
        END ; (* FOR *)
        Player[i] := color ;
      END ; (* IF *)
    END ; (* FOR *)
  ELSIF (y>190) AND (y<210) THEN
    FOR i := 0 TO 5 DO
      IF (x>5+i*25) AND (x<30+i*25) THEN
        color := i ;
        SetAPen(rpp,2+color) ;
      END ; (* IF *)
    END ; (* FOR *)
  END ; (* IF *)
  IF lap=6 THEN
    Show ;
  END ; (* IF *)
END SetColor ;

BEGIN
  AllLevelTermProc(Close) ;
  Build ;
  closed := FALSE ;
  color := -1 ;
  REPEAT
    Ziehe ;
    lap := 0 ;
    SetAPen(rpp,2) ;
    WHILE lap<6 DO
      WaitPort(Win^.userPort) ;
      Msg := GetMsg(Win^.userPort) ;
      IF Msg#NIL THEN
        Class := Msg^.class ;
        Addr := Msg^.iAddress ;
        ReplyMsg(Msg) ;
        IF (mouseButtons IN Class) THEN
          SetColor ;
        ELSIF (closeWindow IN Class) THEN
          lap := 7 ;
          closed := TRUE ;
        ELSIF (gadgetUp IN Class) THEN
          IF Addr=ADR(OKGad) THEN
            Check ;
            INC(lap) ;
          ELSIF Addr=ADR(ShowGad) THEN
            lap := 7 ;
            Show ;
          ELSIF Addr=ADR(EndGad) THEN
            lap := 7 ;
            closed := TRUE ;
          END ; (* IF *)
        END ; (* IF *)
      END ; (* IF *)
    END ; (* WHILE *)
    Clear ;
  UNTIL closed ;
END MasterMind .