<> DIRECTORY GEditClasses, GEditIO, GEditViewer, Graphics USING [black, Color, DrawBox, SetColor, white]; GEditRectangleImpl: PROGRAM IMPORTS GEditIO, GEditViewer, Graphics = BEGIN OPEN GEditViewer, GEditClasses; Rectangle: TYPE = REF RectangleRec ; RectangleRec: TYPE = RECORD [ x1, x2: INTEGER _ 0, y1, y2: INTEGER _ 0, color: Graphics.Color _ Graphics.black -- ideally this would come from the style ] ; RectangleNewProc: NewProc = BEGIN <<[self: Object, x, y: INTEGER]>> rectangle: Rectangle; self.info _ NEW[RectangleRec]; rectangle _ NARROW[self.info]; rectangle.x1 _ x; rectangle.y1 _ y; rectangle.x2 _ x+20; rectangle.y2 _ y+40; rectangle.color _ Graphics.black; END ; RectangleDeleteProc: DeleteProc = BEGIN <<[self: Object]>> <> END ; RectangleMoveProc: MoveProc = BEGIN <<[self: Object, parent: ViewerClasses.Viewer, controlPoint: ControlPoint, grain: SelectionGrain, dx, dy: INTEGER]>> recInfo: Rectangle ~ NARROW[self.info]; BEGIN OPEN recInfo; IF grain=point THEN SELECT controlPoint FROM 0 => {x1 _ x1+dx; y1 _ y1+dy}; 1 => {x1 _ x1+dx; y2 _ y2+dy}; 2 => {x2 _ x2+dx; y1 _ y1+dy}; 3 => {x2 _ x2+dx; y2 _ y2+dy}; ENDCASE ELSE BEGIN x1 _ x1+dx; x2 _ x2+dx; y1 _ y1+dy; y2 _ y2+dy; END; END; END ; RectangleSelectHighlightProc: SelectHighlightProc = BEGIN <<[self: Object, context: Graphics.Context, controlPoint: ControlPoint, grain: SelectionGrain]>> recInfo: Rectangle ~ NARROW[self.info]; DrawControlPoint[context, recInfo.x1, recInfo.y1, IF grain=object OR controlPoint#0 THEN object ELSE point]; DrawControlPoint[context, recInfo.x1, recInfo.y2, IF grain=object OR controlPoint#1 THEN object ELSE point]; DrawControlPoint[context, recInfo.x2, recInfo.y1, IF grain=object OR controlPoint#2 THEN object ELSE point]; DrawControlPoint[context, recInfo.x2, recInfo.y2, IF grain=object OR controlPoint#3 THEN object ELSE point]; END ; RectanglePaintProc: PaintProc = BEGIN <<[self: Object, context: Graphics.Context]>> recInfo: Rectangle ~ NARROW[self.info]; Graphics.SetColor[context, recInfo.color]; Graphics.DrawBox[context, [recInfo.x1, recInfo.y1, recInfo.x2, recInfo.y2]]; END; RectangleResolveProc: ResolveProc = BEGIN <<[self: Object, x, y: INTEGER] RETURNS [affinity: INTEGER, controlPoint: ControlPoint, tx, ty: INTEGER]>> Distance: PROC [objX, objY: INTEGER] RETURNS [INTEGER] = INLINE BEGIN squareRootOfLastIntegerOverTwo: INTEGER ~ 128; dx: INTEGER ~ x-objX; dy: INTEGER ~ y-objY; IF ABS[dx] >= squareRootOfLastIntegerOverTwo OR ABS[dy] >= squareRootOfLastIntegerOverTwo THEN RETURN [LAST[INTEGER]]; RETURN[(dx*dx) + (dy*dy)]; END; recInfo: Rectangle ~ NARROW[self.info]; d0: INTEGER ~ Distance[recInfo.x1, recInfo.y1]; d1: INTEGER ~ Distance[recInfo.x1, recInfo.y2]; d2: INTEGER ~ Distance[recInfo.x2, recInfo.y1]; d3: INTEGER ~ Distance[recInfo.x2, recInfo.y2]; affinity _ MIN[MIN[d0, d1], MIN[d2, d3]]; IF d0=affinity THEN RETURN[affinity, 0, recInfo.x1, recInfo.y1] ELSE IF d1=affinity THEN RETURN[affinity, 1, recInfo.x1, recInfo.y2] ELSE IF d2=affinity THEN RETURN[affinity, 2, recInfo.x2, recInfo.y1] ELSE RETURN[affinity, 3, recInfo.x2, recInfo.y2]; END ; RectangleInputProc: InputProc = BEGIN rec: Rectangle ~ NARROW[self.info]; SELECT input FROM $Black => rec.color _ Graphics.black; $Grey => rec.color _ [rgb, 245B, 245B, 245B]; -- grey hack $White => rec.color _ Graphics.white; ENDCASE; RETURN[FALSE, TRUE]; END; RectangleNextProc: NextProc = {RETURN[(current+(IF backwards THEN 3 ELSE 1)) MOD 4]}; <> <<, , , , >> <> RectangleReadProc: ReadProc = BEGIN <> OPEN GEditIO; rec: Rectangle ~ NEW[RectangleRec]; offset: INT _ 0; temp: INT; [rec.x1, offset] _ GetInteger[specs, offset]; [rec.x2, offset] _ GetInteger[specs, offset]; [rec.y1, offset] _ GetInteger[specs, offset]; [rec.y2, offset] _ GetInteger[specs, offset]; [temp, offset] _ GetInt[specs, offset]; rec.color _ LOOPHOLE[temp]; n.info _ rec; END ; RectangleWriteProc: WriteProc = BEGIN <> OPEN GEditIO; rec: Rectangle ~ NARROW[n.info]; specs _ PutInteger[NIL, rec.x1]; specs _ PutInteger[specs, rec.x2]; specs _ PutInteger[specs, rec.y1]; specs _ PutInteger[specs, rec.y2]; specs _ PutInt[specs, LOOPHOLE[rec.color]]; END ; RectangleCopyProc: CopyProc = BEGIN <> OPEN GEditIO; rec: Rectangle ~ NARROW[old.info]; newinfo _ NEW[RectangleRec _ rec^]; END ; RectangleClassRec: ClassRec _ [ newProc: RectangleNewProc, deleteProc: RectangleDeleteProc, moveProc: RectangleMoveProc, selectProc: RectangleSelectHighlightProc, paintProc: RectanglePaintProc, resolveProc: RectangleResolveProc, inputProc: RectangleInputProc, nextProc: RectangleNextProc, readProc: RectangleReadProc, writeProc: RectangleWriteProc, copyProc: RectangleCopyProc ]; [] _ RegisterClass[$Rectangle, RectangleClassRec]; END.