(*----------------------------------------------------------------------------
 :Program.     SegNum.mod
 :Contents.    Malen von 7-Segment Nummern
 :Author.      Christian Stiens
 :Address.     Snail-Mail:           E-Mail:
 :Address.     Heustiege 2           FIDO: 2:245/5802.25
 :Address.     W-4710 Lüdinghausen   UUCP: Christian_Stiens@ouzonix.bo.open.de
 :Copyright.   public domain
 :Language.    Oberon-2
 :Translator.  Amiga Oberon V2.45d
 :History.     V1.0, 28-Jan-93
 :Support.     Inspired by Pit Burkhardt's DragNumber (see AMOK#1)
----------------------------------------------------------------------------*)

MODULE SegNum;

  IMPORT
    e := Exec,
    g := Graphics,
    I := Intuition,
    ol:= OberonLib;

  TYPE
    Segments = ARRAY 12 OF SET;

  CONST
    segments = Segments({0..4,6},    (* 0 *)
                        {1,3},       (* 1 *)
                        {1,2,4..6},  (* 2 *)
                        {1,3,4,5,6}, (* 3 *)
                        {0,1,3,5},   (* 4 *)
                        {0,3,4,5,6}, (* 5 *)
                        {0,2..6},    (* 6 *)
                        {1,3,4},     (* 7 *)
                        {0..6},      (* 8 *)
                        {0,1,3..6},  (* 9 *)
                        {5},         (* - *)
                        {});         (*   *)
  VAR
    oldx,oldy : INTEGER;
    oldziffW  : INTEGER;
    oldziffH  : INTEGER;
    olddigits : INTEGER;
    oldnum    : LONGINT;
    oldrp     : g.RastPortPtr;


  PROCEDURE MakeTmpRas (rp: g.RastPortPtr);
    VAR tmpRas : g.TmpRasPtr;
        buffer : e.APTR;
        size   : LONGINT;
  BEGIN
    size := LONG(rp.bitMap.bytesPerRow) * LONG(rp.bitMap.rows);
    INCL(ol.MemReqs,e.chip);
    ol.New(buffer,size);
    EXCL(ol.MemReqs,e.chip);
    NEW(tmpRas);
    g.InitTmpRas(tmpRas^,buffer,size);
    rp.tmpRas := tmpRas;
  END MakeTmpRas;


  PROCEDURE MakeArea (rp: g.RastPortPtr; maxvectors: INTEGER);
    VAR areaInfo : g.AreaInfoPtr;
        buffer   : e.APTR;
  BEGIN
    ol.New(buffer,maxvectors * 5);
    NEW(areaInfo);
    g.InitArea(areaInfo^,buffer,maxvectors);
    rp.areaInfo := areaInfo;
  END MakeArea;


  PROCEDURE DrawSeg (rp    : g.RastPortPtr;
                     x,y   : INTEGER;
                     ziffW,
                     ziffH : INTEGER;
                     seg   : INTEGER);
    VAR x1,y1,x2,y2: INTEGER;
        a,b: INTEGER;
        err: BOOLEAN;
  BEGIN
    a := ziffW DIV 8;
    b := ziffH DIV 16;
    IF seg<4 THEN                      (* Vertikales Segment *)
      x1 := x+ (seg MOD 2) *  ziffW;
      y1 := y+ (seg DIV 2) * (ziffH DIV 2);
      x2 := x1;
      y2 := y1+ziffH DIV 2;
      err := g.AreaMove(rp,x1,y1);
      err := g.AreaDraw(rp,x1+a,y1+b); err := g.AreaDraw(rp,x2+a,y2-b);
      err := g.AreaDraw(rp,x2,y2);     err := g.AreaDraw(rp,x2-a,y2-b);
      err := g.AreaDraw(rp,x1-a,y1+b); err := g.AreaDraw(rp,x1,y1);
      err := g.AreaEnd(rp);
    ELSE                               (* Horizontales Segment *)
      x1 := x;
      y1 := y+(seg-4)*(ziffH DIV 2);
      x2 := x1+ziffW;
      y2 := y1;
      err := g.AreaMove(rp,x1,y1);
      err := g.AreaDraw(rp,x1+a,y1-b); err := g.AreaDraw(rp,x2-a,y2-b);
      err := g.AreaDraw(rp,x2,y2);     err := g.AreaDraw(rp,x2-a,y2+b);
      err := g.AreaDraw(rp,x1+a,y1+b); err := g.AreaDraw(rp,x1,y1);
      err := g.AreaEnd(rp);
    END;
  END DrawSeg;


  PROCEDURE DrawSegZiff (rp    : g.RastPortPtr;
                         x,y   : INTEGER;
                         ziffW : INTEGER;
                         ziffH : INTEGER;
                         ziff  : LONGINT);
    VAR i: INTEGER;
  BEGIN
    IF (ziff >= 0) & (ziff <= 11) THEN
      FOR i := 0 TO 6 DO
        IF i IN segments[ziff] THEN
          DrawSeg(rp, x,y, ziffW,ziffH, i);
        END;
      END;
    END;
  END DrawSegZiff;


  PROCEDURE ClearBox(rp: g.RastPortPtr; x,y,w,h: INTEGER);
    VAR apen,open: SHORTINT;
        ol: BOOLEAN;
  BEGIN
    IF (w>0) & (h>0) THEN
      ol := g.areaOutline IN rp.flags;
      open := rp.aOlPen; apen := rp.fgPen;
      g.BndryOff(rp);
      g.SetAPen(rp,0);
      g.RectFill(rp,x,y,x+w,y+h);
      g.SetAPen(rp,apen);
      IF ol THEN g.SetOPen(rp,open) END;
    END;
  END ClearBox;


  PROCEDURE DrawSegNum* (rp     : g.RastPortPtr;
                         x,y    : INTEGER;         (* Position *)
                         ziffW  : INTEGER;         (* Ziffernbreite *)
                         ziffH  : INTEGER;         (* Ziffernhöhe *)
                         num    : LONGINT;         (* Die zu malende Zahl *)
                         digits : INTEGER);        (* Anzahl Stellen *)
    VAR
      i: INTEGER;
      n,nu,oldn,oldnu: LONGINT;
      sign,oldsign: INTEGER;
      left: INTEGER;
      equal: BOOLEAN;
  BEGIN
    IF rp.tmpRas  =NIL THEN MakeTmpRas(rp)  END;
    IF rp.areaInfo=NIL THEN MakeArea(rp,32) END;
    equal := (rp=oldrp)&(x=oldx)&(y=oldy)&(ziffW=oldziffW)&(ziffH=oldziffH)&(olddigits=digits);
    nu := num; oldnu := oldnum;
    n := 0; oldn := 0;
    oldsign := 11; IF oldnu<0 THEN oldnu := -oldnu; oldsign := 10 END;
    sign    := 11; IF    nu<0 THEN    nu := -   nu;    sign := 10 END;
    FOR i := digits-1 TO 0 BY -1 DO
      IF    n<10 THEN    n :=    nu MOD 10;    nu :=    nu DIV 10 END;
      IF oldn<10 THEN oldn := oldnu MOD 10; oldnu := oldnu DIV 10 END;
      IF ~equal OR (n#oldn) THEN
        left := x+i*(ziffW*6 DIV 4);
        ClearBox(rp,left,y,ziffW+ziffW DIV 4,ziffH+ziffH DIV 8);
        DrawSegZiff(rp,left+ziffW DIV 8,y+ziffH DIV 16,ziffW,ziffH,n);
      END;
      IF    nu=0 THEN IF    n>=10 THEN    n := 11 ELSE    n :=    sign END END;
      IF oldnu=0 THEN IF oldn>=10 THEN oldn := 11 ELSE oldn := oldsign END END;
    END;
    oldrp := rp; oldx := x; oldy := y; oldziffW := ziffW; oldziffH := ziffH;
    oldnum := num; olddigits := digits;
  END DrawSegNum;

END SegNum.