Computer Science Canada :: View topic

View.Set ("Graphics:640;440,offscreenonly,nobuttonbar")

type ColorValues :
record
CLR : array 1 .. 3 of int
end record

type PictureVals :
record
RGB : ColorValues
RGBBuffer : ColorValues
end record

class Layer
import ColorValues, PictureVals

var colorBack : ColorValues
colorBack.CLR (1) := 255 % Blue
colorBack.CLR (2) := 255 % Green
colorBack.CLR (3) := 255 % Red

end Layer

module Render
import ColorValues, PictureVals
export Update, ColorBack, DrawDot, Initialize, DrawRect, ColorInvert, ColorInvertArea, Cls, ColorFilter, ColorFilterArea, DrawLine

var imageX : int := 0
var imageY : int := 0
var pictureBound : int := 0
var picture : flexible array 1 .. 0 of PictureVals
var colorBack : ColorValues
colorBack.CLR (1) := 0 % Blue
colorBack.CLR (2) := 0 % Green
colorBack.CLR (3) := 0 % Red

procedure NewLayer

end NewLayer

procedure Initialize (sizeX, sizeY : int)
pictureBound := sizeX * sizeY
if pictureBound > upper (picture) then
new picture, pictureBound
end if
for i : 1 .. pictureBound
picture (i).RGB := colorBack
end for
imageX := sizeX
imageY := sizeY
put picture (upper (picture)).RGB.CLR (1)
end Initialize

procedure ColorBack (R, B, G : int)
if R < 256 and B < 256 and G < 256 and R > -1 and B > -1 and G > -1 then
colorBack.CLR (1) := B
colorBack.CLR (2) := G
colorBack.CLR (3) := R
end if
Error.Halt ("Color Must stay within the range of 0-255.")
end ColorBack

procedure ColorInvert
for i : 1 .. pictureBound
picture (i).RGB.CLR (1) := 255 - picture (i).RGB.CLR (1)
picture (i).RGB.CLR (2) := 255 - picture (i).RGB.CLR (2)
picture (i).RGB.CLR (3) := 255 - picture (i).RGB.CLR (3)
end for
end ColorInvert

procedure ColorInvertArea (x1, y1, x2, y2 : int)
for i : x1 .. x2
for j : y1 .. y2
if i < imageX and i > -1 and j < imageY and j > -1 then
picture ((j - 1) * imageX + i).RGB.CLR (1) := 255 - picture ((j - 1) * imageX + i).RGB.CLR (1)
picture ((j - 1) * imageX + i).RGB.CLR (2) := 255 - picture ((j - 1) * imageX + i).RGB.CLR (2)
picture ((j - 1) * imageX + i).RGB.CLR (3) := 255 - picture ((j - 1) * imageX + i).RGB.CLR (3)
end if
end for
end for
end ColorInvertArea

procedure ColorFilter (R, G, B : int, p : real)
for i : 1 .. pictureBound
picture (i).RGB.CLR (1) := (picture (i).RGB.CLR (1) * (1.0 - p) + B * p) div 2
picture (i).RGB.CLR (2) := (picture (i).RGB.CLR (2) * (1.0 - p) + G * p) div 2
picture (i).RGB.CLR (3) := (picture (i).RGB.CLR (3) * (1.0 - p) + R * p) div 2
end for
end ColorFilter

procedure ColorFilterArea (x1, y1, x2, y2, R, G, B : int, p : real)
for i : x1 .. x2
for j : y1 .. y2
if i < imageX + 1 and i > -1 and j < imageY + 1 and j > -1 then
picture ((j - 1) * imageX + i).RGB.CLR (1) := (picture ((j - 1) * imageX + i).RGB.CLR (1) * (1.0 - p) + B * p) div 2
picture ((j - 1) * imageX + i).RGB.CLR (2) := (picture ((j - 1) * imageX + i).RGB.CLR (2) * (1.0 - p) + G * p) div 2
picture ((j - 1) * imageX + i).RGB.CLR (3) := (picture ((j - 1) * imageX + i).RGB.CLR (3) * (1.0 - p) + R * p) div 2
end if
end for
end for
end ColorFilterArea

procedure DrawDot (x, y, R, G, B : int)
if x < imageX + 1 and x > -1 and y < imageY + 1 and y > -1 then
picture ((y - 1) * imageX + x).RGB.CLR (1) := B
picture ((y - 1) * imageX + x).RGB.CLR (2) := G
picture ((y - 1) * imageX + x).RGB.CLR (3) := R
end if
end DrawDot

procedure DrawLine (x1, y1, x2, y2, R, G, B : int)
var distX : real := x2 - x1 % 5
var distY : real := y2 - y1 % 10
var totDist : real := sqrt (distX * distX + distY * distY)
distX := distX / distY % 0.5
distY := 1 % 1
var inc : real := 0
for y : 0 .. round (totDist) %25 + 100 = 11.18
DrawDot (x1 + round (inc), y1 + y, round (R * (inc rem 1)), round (G* (inc rem 1)), round (B* (inc rem 1)))
DrawDot (x1 + round (inc + (1-(inc rem 1))), y1 + y, round (R * (inc rem 1)), round (G* (inc rem 1)), round (B* (inc rem 1)))
inc := inc + distX
end for
end DrawLine

procedure DrawRect (x1, y1, x2, y2, R, G, B : int)
for i : x1 .. x2
for j : y1 .. y2
DrawDot (i, j, R, G, B)
end for
end for
end DrawRect

procedure Update
var b : array 1 .. sizepic (1, 1, imageX, imageY) of int
cls
takepic (1, 1, imageX, imageY, b)
for i : 19 .. upper (b)
b (i) := 0
end for
b (7) := 48
var id := 19
var imageID : int := 0
var n : int := 0
for j : 1 .. imageY
for i : 1 .. imageX
imageID := imageID + 1
for p : 1 .. 3
b (id)| = picture (imageID).RGB.CLR (p) shl n %b
if n < 24 then
n += 8
else
n := 0
id += 1
end if
end for
end for
if n > 0 then
id += 1
n := 0
end if
end for
drawpic (1, 1, b, 1)
var pic1 : int := Pic.New (1, 1, imageX, imageY)
var pic2 : int := Pic.Scale (pic1, maxx, maxy)
Pic.Draw (pic2, 0, 0, picCopy)
View.Update
Pic.Free (pic1)
Pic.Free (pic2)
end Update

procedure Cls
for i : 1 .. pictureBound
picture (i).RGB := colorBack
end for
end Cls
end Render

Render.Initialize (maxx div 2, maxy div 2)
Render.DrawDot (maxx div 2, maxy div 2, 255, 255, 255)
Render.DrawDot (1, 1, 255, 255, 255)
Render.DrawLine (1, 1, maxx div 2, 50, 255,255, 255)
Render.DrawRect (32, 30, 50, 50, 255, 55, 55)
Render.ColorInvertArea (20, 20, 40, 40)
Render.ColorFilterArea (50, 50, 256, 256, 55, 250, 105, 0.2)

Render.Update

proc drawfillroundbox (x1, y1, x2, y2, xr, yr, clr : int)
var minx : int := min (x1, x2)
var miny : int := min (y1, y2)
var Maxx : int := max (x1, x2)
var Maxy : int := max (y1, y2)
var XR : int := min (Maxx - minx, xr) % so it doesnt end up drawing a box
var YR : int := min (Maxy - miny, yr)
drawfillarc (minx + XR, miny + YR, XR, YR, 180, 270, clr)
drawfillarc (minx + XR, Maxy - YR, XR, YR, 90, 180, clr)
drawfillarc (Maxx - XR, miny + YR, XR, YR, 270, 360, clr)
drawfillarc (Maxx - XR, Maxy - YR, XR, YR, 0, 90, clr)
drawfillbox (minx, miny + YR, Maxx, Maxy - YR, clr)
drawfillbox (minx + XR, miny, Maxx - XR, Maxy, clr)
end drawfillroundbox

proc drawroundbox (x1, y1, x2, y2, xr, yr, clr : int)
var minx : int := min (x1, x2)
var miny : int := min (y1, y2)
var Maxx : int := max (x1, x2)
var Maxy : int := max (y1, y2)
var XR : int := min (Maxx - minx, xr) % so it doesnt end up drawing a box
var YR : int := min (Maxy - miny, yr)
drawarc (minx + XR, miny + YR, XR, YR, 180, 270, clr)
drawarc (minx + XR, Maxy - YR, XR, YR, 90, 180, clr)
drawarc (Maxx - XR, miny + YR, XR, YR, 270, 360, clr)
drawarc (Maxx - XR, Maxy - YR, XR, YR, 0, 90, clr)
drawline (minx + XR, miny, Maxx - XR, miny, clr)
drawline (minx + XR, Maxy, Maxx - XR, Maxy, clr)
drawline (minx, miny + YR, minx, Maxy - YR, clr)
drawline (Maxx, miny + YR, Maxx, Maxy - YR, clr)
end drawroundbox

% Basically
var test : flexible array 1..3, 1..3 of int

new test, 4, 3 % Is allowed since only the first dimension in modified

new test, 0, 0 % Are all allowed since the upper bound of at least one
new test, 3, 0 % of the dimensions is lower than its lower bounds
new test, 5, 0 % (this creates an array of size 0)

new test, 3, 6 % Are not allowed since a dimension other than the first
new test, 2, 9 % (the second in this case) is modified without producing an array of size 0

var x : flexible array 1 .. 0, 1 .. 0 of int

new x , 1,1
x(1,1) := 0
put x(1,1)

new x , 1,2
x(1,2) := 0
put x(1,2)

type Pixel :
record
CLR : array 1 .. 3 of int2
Alpha : real4
end record

type Buffer :
record
RGB : Pixel
Depth : int1
end record

class Layer
import Pixel, Buffer
export Resize, LoadLayerFile, SaveLayerFile, Capture, Display, Scale, Clear, Transparency, Invert, ColorBack, TransparencyNoColor, ColorBackRed, ColorBackGreen,
ColorBackBlue, BlackWhite, FilterColor, Depth, DrawDot, DrawOval, DrawArc

const TransperentColor : int1 := 0
const maxColor : int := 255 shl 0| 255 shl 8| 255 shl 16| 255 shl 24
const LayerFileExtension : string := "lbm"
var widthLayer, heightLayer : int2 := 0
var posXLayer, posYLayer : int2 := 0
var scale : int2 := 0
var depth : int1 := 0
var layer : flexible array 1 .. 0 of Buffer
var layerBoundSize : int := 0

function GetColors (x : int) : array 0 .. 3 of int
var resultingValue : array 0 .. 3 of int %The Color values.
var y : nat := 0
if x < 0 then
y := (maxnat) & (x)
else
y := x
end if

%A temp variable to hold the value sent from the bitmap
for i : 0 .. 3 %for all 4 values
resultingValue (3 - i) := y shr ((3 - i) * 8) %the color is equal to temp variable's value shift right (3-i)*8
y := y - (resultingValue (3 - i) shl ((3 - i) * 8)) % the temp variable is subtracted by the color value shift left (3-i)*8
end for % end for
if y = 0 then
result resultingValue
end if
end GetColors

procedure Resize (x, y : int)
widthLayer := x
heightLayer := y
layerBoundSize := widthLayer * heightLayer
var tempSize : int := upper (layer)
if layerBoundSize > upper (layer) then
new layer, layerBoundSize
end if
for i : tempSize + 1 .. upper (layer)
layer (i).RGB.CLR (1) := 0
layer (i).RGB.CLR (2) := 0
layer (i).RGB.CLR (3) := 0
layer (i).RGB.Alpha := 1
layer (i).Depth := 0
end for
end Resize

procedure SaveLayerFile (name : string)
var saveName : string := name + "." + LayerFileExtension

end SaveLayerFile

procedure LoadLayerFile (name : string)
var saveName : string := name + "." + LayerFileExtension
end LoadLayerFile

procedure Capture (xPos1, yPos1, xPos2, yPos2 : int)
var valID : int := 21
var b : array 1 .. sizepic (xPos1, yPos1, xPos2, yPos2) of int
var tempArray : array 0 .. 3 of int
for i : 1 .. upper (b)
b (i) := 0
end for
takepic (xPos1, yPos1, xPos2, yPos2, b)
Resize (b (2), b (1))
posXLayer := xPos1
posYLayer := yPos1

var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
tempArray := GetColors (b (i))
for j : 0 .. 3
imageColorShade := imageColorShade + 1
layer (imageID).RGB.CLR (imageColorShade) := tempArray (j)
if imageColorShade > 2 then
imageColorShade := 0
imageID := imageID + 1
end if
end for
end for

end Capture

procedure Display
cls
var b : array 1 .. sizepic (1, 1, widthLayer, heightLayer) of int
takepic (1, 1, widthLayer, heightLayer, b)
var valID : int := 21
for i : valID .. upper (b)
b (i) := 0
end for
b (7) := 56 % why 56? it changes how the image is shifted when redrawn
var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
for j : 0 .. 3
imageColorShade := imageColorShade + 1
b (i)| = layer (imageID).RGB.CLR (imageColorShade) shl (j * 8)
if imageColorShade > 2 then
imageColorShade := 0
imageID := imageID + 1
end if
end for

end for

drawpic (posXLayer, posYLayer, b, 1)
delay (1)
var pic1 : int := Pic.New (posXLayer, posYLayer, posXLayer + widthLayer, posYLayer + heightLayer)
var pic2 : int := Pic.Scale (pic1, widthLayer * scale, heightLayer * scale)
Pic.Draw (pic1, posXLayer + widthLayer + 10, posXLayer, picCopy)
View.Update
Pic.Free (pic1)
Pic.Free (pic2)
end Display

procedure Clear
for i : 1 .. upper (layer)
layer (i).RGB.CLR (1) := TransperentColor
layer (i).RGB.CLR (2) := TransperentColor
layer (i).RGB.CLR (3) := TransperentColor
end for
end Clear

procedure Scale (x : int2)
scale := x
end Scale

procedure Depth (x : int2)
depth := x
end Depth

procedure Transparency (x : real4)
for i : 1 .. upper (layer)
layer (i).RGB.Alpha := x
end for
end Transparency

procedure Invert
for i : 1 .. upper (layer)
layer (i).RGB.CLR (1) := 255 - layer (i).RGB.CLR (1)
layer (i).RGB.CLR (2) := 255 - layer (i).RGB.CLR (2)
layer (i).RGB.CLR (3) := 255 - layer (i).RGB.CLR (3)
end for
end Invert

procedure TransparencyNoColor (x : real4)
for i : 1 .. upper (layer)
if layer (i).RGB.CLR (1) + layer (i).RGB.CLR (2) + layer (i).RGB.CLR (3) = (TransperentColor * 3) then
layer (i).RGB.Alpha := x
end if
end for
end TransparencyNoColor

procedure ColorBack (R, G, B : int)
for i : 1 .. upper (layer)
layer (i).RGB.CLR (3) := R
layer (i).RGB.CLR (2) := G
layer (i).RGB.CLR (1) := B
end for
end ColorBack

procedure ColorBackRed (R : int)
for i : 1 .. upper (layer)
layer (i).RGB.CLR (3) := R
end for
end ColorBackRed

procedure ColorBackGreen (G : int)
for i : 1 .. upper (layer)
layer (i).RGB.CLR (2) := G
end for
end ColorBackGreen

procedure ColorBackBlue (B : int)
for i : 1 .. upper (layer)
layer (i).RGB.CLR (1) := B
end for
end ColorBackBlue

procedure BlackWhite
var tempVal : int
for i : 1 .. upper (layer)
tempVal := (layer (i).RGB.CLR (1) + layer (i).RGB.CLR (2) + layer (i).RGB.CLR (3)) div 3
layer (i).RGB.CLR (1) := tempVal
layer (i).RGB.CLR (2) := tempVal
layer (i).RGB.CLR (3) := tempVal
end for
end BlackWhite

procedure FilterColor (R, G, B : int, percent : real)
for i : 1 .. upper (layer)
layer (i).RGB.CLR (3) := round ((layer (i).RGB.CLR (3) * (1 - percent)) + (R * percent))
layer (i).RGB.CLR (2) := round ((layer (i).RGB.CLR (2) * (1 - percent)) + (G * percent))
layer (i).RGB.CLR (1) := round ((layer (i).RGB.CLR (1) * (1 - percent)) + (B * percent))
end for
end FilterColor

procedure DrawDot (x, y, R, G, B : int)
if x < widthLayer + 1 and x > 0 and y < heightLayer + 1 and y > 0 then
layer ((y - 1) * widthLayer + x).RGB.CLR (3) := R
layer ((y - 1) * widthLayer + x).RGB.CLR (2) := G
layer ((y - 1) * widthLayer + x).RGB.CLR (1) := B
end if
end DrawDot

procedure DrawOval (x, y, radX, radY, R, G, B : int)
var perimeter : real := 3.1415 * radX * radY
var angleInc : real := 360 / perimeter
for i : 1 .. round (perimeter)
DrawDot (x + round (radX * cosd (angleInc * i)), y + round (radY * sind (angleInc * i)), R, G, B)
end for
end DrawOval

procedure DrawArc (x, y, radX, radY : int, initA, finishA : real, R, G, B : int)
var perimeter : real := (finishA - initA) / 360 * 3.1415 * radX * radY
var angleInc : real := (finishA - initA) / perimeter
for i : 1 .. round (perimeter)
DrawDot (x + round (radX * cosd (initA + angleInc * i)), y + round (radY * sind (initA + angleInc * i)), R, G, B)
end for
end DrawArc

end Layer

class Render
import Layer

procedure AddLayer (layerX : pointer to Layer)

end AddLayer

procedure Color

end Color

procedure Update

end Update
end Render

View.Set ("Graphics:max;max,offscreenonly,nobuttonbar")

procedure Test1
var layer1 : pointer to Layer
new Layer, layer1
var pic1 : int := Pic.FileNew ("test4.bmp")
Pic.Draw (pic1, 1, 1, picCopy)
put Pic.Width (pic1), ":", Pic.Height (pic1)
View.Update
delay (1000)
layer1 -> Capture (1, 1, Pic.Width (pic1), Pic.Height (pic1))

cls
layer1 -> Scale (1)
layer1 -> Display
Pic.Draw (pic1, 1, 1, picCopy)
Pic.Free (pic1)
end Test1

Test1

type PixelValues :
record
CLR : array 1 .. 3 of int2
Alpha : real4
end record

type Pixel :
record
RGB : PixelValues
Depth : int1
end record

class Image
import Pixel, PixelValues, File
export ImageSize, ImageWidth, ImageHeight, Export, Save, Load, Capture, CaptureAlpha, Display, Depth, MergeAlphaLayer,

SetColor, Invert, Clear, AlphaBack, ColorBack, NoColorAlpha, ColorBackRed, ColorBackGreen, ColorBackBlue, BlackWhite, FilterColor,

DrawDot, DrawOval, DrawArc

const AutoOverwrite : boolean := true
const TransperentColor : int1 := 0
const LayerFileExtension : string := "lbm"
var widthLayer, heightLayer : int2 := 0
var posXLayer, posYLayer : int2 := 0
var setColor : PixelValues
var scale : int2 := 0
var depth : int1 := 0
var layer : flexible array 1 .. 0 of Pixel
var layerBoundSize : int := 0
setColor.CLR (1) := 0
setColor.CLR (2) := 0
setColor.CLR (3) := 0
setColor.Alpha := 0
/*
PRIVATE METHODS
*/
procedure Resize (x, y : int)
widthLayer := x
heightLayer := y
layerBoundSize := widthLayer * heightLayer
var tempSize : int := upper (layer)
if layerBoundSize > upper (layer) then
new layer, layerBoundSize
end if
for i : tempSize + 1 .. upper (layer)
layer (i).RGB.CLR (1) := 0
layer (i).RGB.CLR (2) := 0
layer (i).RGB.CLR (3) := 0
layer (i).RGB.Alpha := 1
layer (i).Depth := 0
end for
end Resize

function GetColors (x : int) : array 0 .. 3 of int
var resultingValue : array 0 .. 3 of int %The Color values.
var y : nat := 0 %A temp variable to hold the value sent from the bitmap
if x < 0 then
y := (maxnat) & (x)
else
y := x
end if

for i : 0 .. 3 %for all 4 values
resultingValue (3 - i) := y shr ((3 - i) * 8) %the color is equal to temp variable's value shift right (3-i)*8
y := y - (resultingValue (3 - i) shl ((3 - i) * 8)) % the temp variable is subtracted by the color value shift left (3-i)*8
end for % end for
if y = 0 then
result resultingValue
end if
end GetColors
/*
PUBLIC METHODS
*/
procedure Capture (xPos1, yPos1, xPos2, yPos2 : int)
var valID : int := 21
var b : array 1 .. sizepic (xPos1, yPos1, xPos2, yPos2) of int
var tempArray : array 0 .. 3 of int
for i : 1 .. upper (b)
b (i) := 0
end for
takepic (xPos1, yPos1, xPos2, yPos2, b)
Resize (b (2), b (1))
posXLayer := xPos1
posYLayer := yPos1

var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
tempArray := GetColors (b (i))
for j : 0 .. 3
imageColorShade := imageColorShade + 1
layer (imageID).RGB.CLR (imageColorShade) := tempArray (j)
if imageColorShade > 2 then
imageColorShade := 0
imageID := imageID + 1
end if
end for
end for
end Capture

procedure CaptureAlpha (xPos1, yPos1, xPos2, yPos2 : int)
var valID : int := 21
var b : array 1 .. sizepic (xPos1, yPos1, xPos2, yPos2) of int
var tempArray : array 0 .. 3 of int
for i : 1 .. upper (b)
b (i) := 0
end for
takepic (xPos1, yPos1, xPos2, yPos2, b)
Resize (b (2), b (1))
posXLayer := xPos1
posYLayer := yPos1

var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
tempArray := GetColors (b (i))
for j : 0 .. 3
imageColorShade := imageColorShade + 1
layer (imageID).RGB.Alpha := layer (imageID).RGB.Alpha + tempArray (j)
if imageColorShade > 2 then
imageColorShade := 0
layer (imageID).RGB.Alpha := ((layer (imageID).RGB.Alpha - 1) div 3) / 255
imageID := imageID + 1
end if
end for
end for
end CaptureAlpha

procedure Save (name : string)
var saveName : string := name + "." + LayerFileExtension
var fileStream : int := 0
if File.Exists (saveName) = true then
if AutoOverwrite then
File.Delete (saveName)
else
Error.Halt ("Auto Overide off, will implement other options later.")
end if
end if
open : fileStream, saveName, put
put : fileStream, intstr (layerBoundSize) + " " ..
put : fileStream, intstr (widthLayer) + " " ..
put : fileStream, intstr (heightLayer) + " " ..
var tempValue : nat := 0
for i : 1 .. layerBoundSize
tempValue := 0
for j : 1 .. 3
tempValue| = layer (i).RGB.CLR (j) shl ((j - 1) * 8)
end for
tempValue| = round (254 * layer (i).RGB.Alpha) shl 24
put : fileStream, natstr (tempValue) + " " ..
end for
close (fileStream)
end Save

procedure Load (name : string)
var loadName : string := name + "." + LayerFileExtension
var fileStream : int

if File.Exists (loadName) = true then
var tempValue : string := ""
open : fileStream, loadName, get
get : fileStream, tempValue
layerBoundSize := strint (tempValue)
get : fileStream, tempValue
widthLayer := strint (tempValue)
get : fileStream, tempValue
heightLayer := strint (tempValue)
Resize (widthLayer, heightLayer)
var y : nat := 0
for i : 1 .. layerBoundSize
get : fileStream, tempValue
y := strnat (tempValue)
layer (i).RGB.Alpha := y shr 24
y := y - (round (layer (i).RGB.Alpha) shl 24)
for j : 1 .. 3
layer (i).RGB.CLR (4 - j) := y shr ((3 - j) * 8) %the color is equal to temp variable's value shift right (3-i)*8
y := y - (layer (i).RGB.CLR (4 - j) shl ((3 - j) * 8)) % the temp variable is subtracted by the color value shift left (3-i)*8
end for %
end for
for i : 1 .. layerBoundSize
layer (i).RGB.Alpha := layer (i).RGB.Alpha / 255
end for
else
Error.Halt ("No file Found")
end if
end Load

procedure Display
var b : array 1 .. sizepic (1, 1, widthLayer, heightLayer) of int
takepic (1, 1, widthLayer, heightLayer, b)
var valID : int := 21
for i : valID .. upper (b)
b (i) := 0
end for
b (7) := 56
var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
for j : 0 .. 3
imageColorShade := imageColorShade + 1
b (i)| = round (layer (imageID).RGB.CLR (imageColorShade) * layer (imageID).RGB.Alpha) shl (j * 8)
if imageColorShade > 2 then
imageColorShade := 0
imageID := imageID + 1
end if
end for

end for

drawpic (posXLayer, posYLayer, b, 1)
var pic1 : int := Pic.New (posXLayer, posYLayer, posXLayer + widthLayer, posYLayer + heightLayer)
Pic.Draw (pic1, posXLayer, posYLayer, picCopy)
View.Update
Pic.Free (pic1)
end Display

procedure Export (var exportBuffer : array 1 .. * of Pixel)
for i : 1 .. layerBoundSize
exportBuffer (i) := layer (i)
end for
end Export

procedure Clear
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (1) := TransperentColor
layer (i).RGB.CLR (2) := TransperentColor
layer (i).RGB.CLR (3) := TransperentColor
end for
end Clear

procedure SetColor (RedV, GreenV, BlueV : int, AlphaV : real)
setColor.CLR (3) := RedV
setColor.CLR (2) := GreenV
setColor.CLR (1) := BlueV
setColor.Alpha := AlphaV
end SetColor

function ImageSize : int
result widthLayer * heightLayer
end ImageSize

function ImageWidth : int
result widthLayer
end ImageWidth

function ImageHeight : int
result heightLayer
end ImageHeight

procedure Depth (x : int2)
depth := x
end Depth

procedure MergeAlphaLayer
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (1) := round (layer (i).RGB.CLR (1) * layer (i).RGB.Alpha)
layer (i).RGB.CLR (2) := round (layer (i).RGB.CLR (2) * layer (i).RGB.Alpha)
layer (i).RGB.CLR (3) := round (layer (i).RGB.CLR (3) * layer (i).RGB.Alpha)
layer (i).RGB.Alpha := 1
end for
end MergeAlphaLayer

procedure Invert
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (1) := 255 - layer (i).RGB.CLR (1)
layer (i).RGB.CLR (2) := 255 - layer (i).RGB.CLR (2)
layer (i).RGB.CLR (3) := 255 - layer (i).RGB.CLR (3)
end for
end Invert

procedure NoColorAlpha (x : real4)
for i : 1 .. layerBoundSize
if layer (i).RGB.CLR (1) + layer (i).RGB.CLR (2) + layer (i).RGB.CLR (3) = (TransperentColor * 3) then
layer (i).RGB.Alpha := x
end if
end for
end NoColorAlpha

procedure ColorBack
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (3) := setColor.CLR (3)
layer (i).RGB.CLR (2) := setColor.CLR (2)
layer (i).RGB.CLR (1) := setColor.CLR (1)
end for
end ColorBack

procedure ColorBackRed
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (3) := setColor.CLR (3)
end for
end ColorBackRed

procedure ColorBackGreen
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (2) := setColor.CLR (2)
end for
end ColorBackGreen

procedure ColorBackBlue
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (1) := setColor.CLR (1)
end for
end ColorBackBlue

procedure AlphaBack
for i : 1 .. layerBoundSize
layer (i).RGB.Alpha := setColor.Alpha
end for
end AlphaBack

procedure BlackWhite
var tempVal : int
for i : 1 .. layerBoundSize
tempVal := (layer (i).RGB.CLR (1) + layer (i).RGB.CLR (2) + layer (i).RGB.CLR (3)) div 3
layer (i).RGB.CLR (1) := tempVal
layer (i).RGB.CLR (2) := tempVal
layer (i).RGB.CLR (3) := tempVal
end for
end BlackWhite

procedure FilterColor (percent : real)
for i : 1 .. layerBoundSize
layer (i).RGB.CLR (3) := round ((layer (i).RGB.CLR (3) * (1 - percent)) + (setColor.CLR (3) * percent))
layer (i).RGB.CLR (2) := round ((layer (i).RGB.CLR (2) * (1 - percent)) + (setColor.CLR (2) * percent))
layer (i).RGB.CLR (1) := round ((layer (i).RGB.CLR (1) * (1 - percent)) + (setColor.CLR (1) * percent))
end for
end FilterColor

procedure DrawDot (x, y : int)
if x < widthLayer + 1 and x > 0 and y < heightLayer + 1 and y > 0 then
layer ((y - 1) * widthLayer + x).RGB.CLR (3) := setColor.CLR (3)
layer ((y - 1) * widthLayer + x).RGB.CLR (2) := setColor.CLR (2)
layer ((y - 1) * widthLayer + x).RGB.CLR (1) := setColor.CLR (1)
end if
end DrawDot

procedure DrawOval (x, y, radX, radY : int)
var perimeter : real := 3.1415 * radX * radY
var angleInc : real := 360 / perimeter
for i : 1 .. round (perimeter)
DrawDot (x + round (radX * cosd (angleInc * i)), y + round (radY * sind (angleInc * i)))
end for
end DrawOval

procedure DrawArc (x, y, radX, radY : int, initA, finishA : real)
var perimeter : real := (finishA - initA) / 360 * 3.1415 * radX * radY
var angleInc : real := (finishA - initA) / perimeter
for i : 1 .. round (perimeter)
DrawDot (x + round (radX * cosd (initA + angleInc * i)), y + round (radY * sind (initA + angleInc * i)))
end for
end DrawArc

end Image

module Render
import Image, File, Pixel, PixelValues
export ResizeScreen, Buffer, Update, Clear

const ScreenDepth : int := 0
var screenBuffer : flexible array 1 .. 0 of Pixel
var screenID : int := 0
var screenBound : int := 0
var screenWidth : int := 0
var screenHeight : int := 0
var screenSize : int := 0
var screenScale : real := 0
var backColor : PixelValues
backColor.CLR (1) := 0
backColor.CLR (2) := 0
backColor.CLR (3) := 0
backColor.Alpha := 0

procedure ResizeScreen (width, height : int, scale : real, modes : string)
if screenID not= 0 then
Window.Close (screenID)
end if
screenID := Window.Open ("Graphics:" + intstr (width) + ";" + intstr (height) + "," + modes)
screenWidth := round (width * scale)
screenHeight := round (height * scale)
put screenWidth
screenBound := screenWidth * screenHeight
if screenBound > upper (screenBuffer) then
new screenBuffer, screenBound
end if
screenScale := 1 / scale

end ResizeScreen

procedure Buffer (imagePosX, imagePosY : int, image : pointer to Image)
/*First import the values from the image.*/
var tempBound : array 1 .. image -> ImageSize of Pixel
image -> Export (tempBound)
/*Second take the values and set them based on Depth*/
for x : 1 .. image -> ImageWidth
for y : 1 .. image -> ImageHeight
if (imagePosX + x) > 0 and (imagePosX + x) < screenWidth and (imagePosY + y) > 0 and (imagePosY + y) < screenHeight then
if tempBound (((y - 1) * image -> ImageWidth) + x).Depth > screenBuffer (((y - 1) * screenWidth) + x).Depth then
screenBuffer (((y - 1) * screenWidth) + x).Depth := tempBound (((y - 1) * image -> ImageWidth) + x).Depth

screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (1) := round (tempBound (((y - 1) * image -> ImageWidth) + x).RGB.CLR (1) * tempBound (((y - 1) * image -> ImageWidth) + x)
.RGB.Alpha) - round (screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (1) * (1 - tempBound (((y - 1) * image -> ImageWidth) + x).RGB.Alpha))

screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (2) := round (tempBound (((y - 1) * image -> ImageWidth) + x).RGB.CLR (2) * tempBound (((y - 1) * image -> ImageWidth) + x)
.RGB.Alpha) - round (screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (2) * (1 - tempBound (((y - 1) * image -> ImageWidth) + x).RGB.Alpha))

screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (3) := round (tempBound (((y - 1) * image -> ImageWidth) + x).RGB.CLR (3) * tempBound (((y - 1) * image -> ImageWidth) + x)
.RGB.Alpha) - round (screenBuffer (((y - 1) * screenWidth) + x).RGB.CLR (3) * (1 - tempBound (((y - 1) * image -> ImageWidth) + x).RGB.Alpha))

%screenBuffer (((y - 1) * screenWidth) + x).RGB.Alpha := 2 / (screenBuffer (((y - 1) * screenWidth) + x).RGB.Alpha + tempBound (((y - 1) * image -> ImageWidth) + x).RGB.Alpha)

else /*if depth is Lesser or equal*/

end if
end if
end for
end for
end Buffer

procedure Update
cls
var b : array 1 .. screenSize of int
takepic (1, 1, screenWidth, screenHeight, b)
var valID : int := 21
for i : valID .. upper (b)
b (i) := 0
end for
b (7) := 56
var imageID : int := 1
var imageColorShade : int := 0
for i : valID .. (b (13) div 4) + valID - 1
for j : 0 .. 3
imageColorShade := imageColorShade + 1
b (i)| = screenBuffer (imageID).RGB.CLR (imageColorShade) shl (j * 8)
if imageColorShade > 2 then
imageColorShade := 0
imageID := imageID + 1
end if
end for

end for
drawpic (1, 1, b, 1)
var pic1 : int := Pic.New (1, 1, 1 + screenWidth, 1 + screenHeight)
var pic2 : int := Pic.Scale (pic1, round (screenWidth * screenScale), round (screenHeight * screenScale))
Pic.Draw (pic2, 1, 1, picCopy)
Window.Update (screenID)
Pic.Free (pic1)
Pic.Free (pic2)
end Update

procedure Clear
for i : 1 .. screenBound
screenBuffer (i).RGB := backColor
screenBuffer (i).Depth := ScreenDepth
end for
end Clear

end Render

procedure ClassTest1
var picture1 : ^Image
new Image, picture1
Render.ResizeScreen (640, 440, 1, "nobuttonbar,offscreenonly,title;Render Test")
picture1 -> Load ("TestSaveFile1")
picture1 -> Invert
picture1 -> Display

Render.Buffer (20, 20, picture1)
Render.Update

end ClassTest1

procedure SaveNewImage (name : string)
var pic1 : int := Pic.FileNew (name)
Pic.Draw (pic1, 1, 1, picCopy)
var imageTemp : ^Image
new Image, imageTemp
imageTemp -> Capture (1, 1, Pic.Width (pic1), Pic.Height (pic1))
imageTemp -> Save ("TestSaveFile1")
Pic.Free (pic1)
end SaveNewImage

SaveNewImage (#"imageName.bmp")
ClassTest1

Author:	copthesaint [ Tue May 08, 2012 2:03 pm ]
Post subject:	Re: New Draw Module
I have updated the module, Currently you can draw: - Ovals - FillRectangles - lines (Problem with rounding I think, if anyone wants to look at that.) - polygons (Problem with lines causes problem with polygons) Currently you can also: -Invert Colors -Fixed Color Filter I wish I could have done this sooner but I have been busy. @evildaddy that can definatly be done but right now Im just figuring the math out behind the draw modules. Its something ive never spent the time to learn or figure out. @compsci, if anyone wants anything like evildaddy Its more then fine to post it here, but right now I just need reasorces for the mathematics of drawing objects by each individual pixel.

Author:	Amarylis [ Wed May 09, 2012 9:10 pm ]
Post subject:	RE:New Draw Module
As I mentioned in the other post, I'd love 2D array buffers as opposed to 1D array buffers

Author:	copthesaint [ Wed May 09, 2012 10:36 pm ]
Post subject:	RE:New Draw Module
Although I could do that, it would be useless because turing doesnt allow flexible arrays of fleixble array. plus manipulating a one dimensional array that holds only values specific to the pixel at that index is a hell of alot easier then dealing with a 1 dimensional buffer that holds more then one pixels values at a certain index point.

Author:	Raknarg [ Thu May 10, 2012 12:44 pm ]
Post subject:	RE:New Draw Module
@copthesaint var arr : flexible array 1 .. 3, 1 .. 3 of int new arr, 2, 3 Works as long as you only change the first element. Maybe that helps.

Author:	Amarylis [ Thu May 10, 2012 12:49 pm ]
Post subject:	RE:New Draw Module
Works with both of them new ar, 1, 0 chances the array bounds to 1, 0

Author:	Raknarg [ Thu May 10, 2012 12:50 pm ]
Post subject:	RE:New Draw Module
You're sure it works? Whenever I try to change the second element, it gives me an error, saying that it hasnt been implemented yet

Author:	Amarylis [ Thu May 10, 2012 1:27 pm ]
Post subject:	RE:New Draw Module
What version of Turing are you using?

Author:	Raknarg [ Thu May 10, 2012 2:20 pm ]
Post subject:	RE:New Draw Module
So basically you can either make it smaller or change the first one.

Author:	Dreadnought [ Thu May 10, 2012 2:47 pm ]
Post subject:	Re: New Draw Module
There is only one kind of "smaller" that is allowed and that is size 0. Note that a size 0 flexible array can be changed into an array of any size you desire.

Author:	Dreadnought [ Thu May 10, 2012 4:10 pm ]
Post subject:	Re: New Draw Module
I feel bad for steering this post off-topic, but your code (copy-pasted as is) produces the same error in both Turing 4.0.5, 4.1.1 and 4.1.2. What version might you be using?

Author:	Amarylis [ Thu May 10, 2012 4:12 pm ]
Post subject:	RE:New Draw Module
...Open Turing, with some slight modifications done by yours truly.

Author:	copthesaint [ Thu May 10, 2012 4:27 pm ]
Post subject:	RE:New Draw Module
@Dreadnought, You have to use version 4.0.5 and It will work. make sure the splash screen says 4.0.5 when you open turing. I am not using openturing.

Author:	Amarylis [ Thu May 10, 2012 4:30 pm ]
Post subject:	RE:New Draw Module
I know you are not- Dreadnought asked which version I was using

Author:	copthesaint [ Wed May 23, 2012 10:59 am ]
Post subject:	Re: New Draw Module
~Bump I have my whole program working now, I will just remake the whole thing and clean it up. then I will post my first version for turing 4.0.5 that should be bug free. I have already noticed an issue with speed however I will try to optimise my code while I remake it.